prismdrv_set_smioc_info.F90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------
00002 ! Copyright 2006-2010, CERFACS, Toulouse, France.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PRISMDrv_Set_smioc_info
00008 !
00009 ! !INTERFACE
00010 subroutine prismdrv_set_smioc_info(id_err)
00011 
00012 !
00013 ! !USES:
00014 !
00015   USE PSMILE_smioc
00016   USE PRISMDrv, dummy_interface => PRISMDrv_Set_smioc_info
00017 
00018   IMPLICIT NONE
00019 
00020 !
00021 ! !PARAMETERS:
00022 !
00023 
00024 !
00025 ! ! RETURN VALUE
00026 !
00027   INTEGER, INTENT (Out)               :: id_err   ! error value
00028 
00029 ! !DESCRIPTION
00030 ! Subroutine "PRISMDrv_set_smioc_info" sets the information got through 
00031 ! the extraction of information in the smioc files.
00032 !
00033 ! !REVISED HISTORY
00034 !   Date      Programmer   Description
00035 ! ----------  ----------   -----------
00036 ! 03/10/2002  D. Declat    Creation form original prismdrv_set_info.F90
00037 ! 22/03/2010  JM Epitalon  Simultaneous access to multiple SMIOC files
00038 !
00039 ! EOP
00040 !----------------------------------------------------------------------
00041 ! $Id: prismdrv_set_smioc_info.F90 2685 2010-10-28 14:05:10Z coquart $
00042 ! $Author: coquart $
00043 !----------------------------------------------------------------------
00044 !
00045 ! 0. Local declarations
00046 !
00047   CHARACTER(LEN=80), SAVE  :: mycvs = 
00048      '$Id: prismdrv_set_smioc_info.F90 2685 2010-10-28 14:05:10Z coquart $'
00049 !
00050   INTEGER :: ib, ib_bis, ib_ter
00051   INTEGER :: il_exchange_id, il_interp_id
00052 !
00053 ! array used to check and count the transient informations
00054 ! the first element is the trans_in id, the second, the trans_out_id,
00055 ! the third is src_comp_id, the fourth is the tgt_comp_id,
00056 ! the fifth is the trans_in_type,
00057 ! the seventh element validate an exchange once it has been found for
00058 ! transients in and transients out.
00059 !
00060   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_trans_array
00061 !
00062   INTEGER, DIMENSION(:), ALLOCATABLE   :: ila_comp_nb_pes3
00063   INTEGER, DIMENSION(:), ALLOCATABLE   :: ila_comp_nb_pes4
00064   INTEGER                              :: il_begin
00065   INTEGER                              :: il_index
00066 !     ... for error handling
00067   INTEGER, PARAMETER                   :: nerrp = 2
00068   INTEGER                              :: ierrp (nerrp)
00069 !  
00070 !----------------------------------------------------------------------
00071 !----------------------------------------------------------------------
00072 !
00073 !
00074 IF (Appl%rank .eq. PRISM_root) THEN
00075 #ifdef VERBOSE
00076   PRINT *, '| Enter PRISMDrv_set_smioc_info'
00077   call psmile_flushstd
00078 
00079   PRINT *, '| | Information coming from the xml files'
00080   call psmile_flushstd
00081 #endif
00082    !
00083    ! 1. Extract information from the xml files and set the smioc structures
00084    !
00085    call prismdrv_init_smioc_struct(id_err)
00086 
00087    !
00088    ! 2. Set the driver grid structure from the smioc structure
00089    !
00090    ! 2.1. get the number of grids
00091 #ifdef VERBOSE
00092    PRINT *, '| | Number of Grids : ',Number_of_Grids_drv
00093    call psmile_flushstd
00094 #endif
00095    ! 2.2. allocate the global structure for the grids
00096    ALLOCATE(Drv_Grids(Number_of_Grids_drv), stat = id_err)
00097    IF (id_err > 0) THEN
00098          ierrp (1) = id_err
00099          ierrp (2) = Number_of_Grids_drv
00100          id_err = 13
00101 
00102          call psmile_error_common ( id_err, 'Drv_Grids', &
00103             ierrp, 2, __FILE__, __LINE__ )
00104          RETURN
00105    ENDIF
00106 
00107    ! 2.3. for each grid, set the grids information
00108    DO ib = 1, Number_of_Grids_drv
00109 
00110       Drv_Grids(ib)%grid_id          = sga_smioc_grids(ib)%ig_grid_id
00111       Drv_Grids(ib)%comp_id          = sga_smioc_grids(ib)%ig_comp_id
00112 
00113       Drv_Grids(ib)%grid_name        = sga_smioc_grids(ib)%cg_grid_name
00114       DO ib_bis = 1, 3
00115          Drv_Grids(ib)%periodic(ib_bis)= sga_smioc_grids(ib)%iga_periodic(ib_bis)
00116       END DO
00117 
00118    END DO
00119 
00120    !
00121    ! 3. Get the dimensioning number of exchanges, interps and transfs
00122    !
00123    ! 3.1. For all the transient get the number of communications
00124    ALLOCATE(ila_trans_array(ig_nb_tot_transi*10,8), stat = id_err)
00125    IF (id_err > 0) THEN
00126          ierrp (1) = id_err
00127          ierrp (2) = ig_nb_tot_transi*10*8
00128          id_err = 13
00129 
00130          call psmile_error_common ( id_err, 'ila_trans_array', &
00131             ierrp, 2, __FILE__, __LINE__ )
00132          RETURN
00133    ENDIF
00134 
00135    ila_trans_array(:,:) = -1
00136    Number_of_comms = 0
00137    Number_of_Interps = 0
00138    Number_of_Transfs = 0
00139 
00140    DO ib = 1, ig_nb_tot_transi
00141     
00142       IF ((sga_smioc_transi(ib)%sg_transi_in%ig_nb_in_orig) .ne. 0) THEN
00143         
00144          DO ib_bis = 1, sga_smioc_transi(ib)%sg_transi_in%ig_nb_in_orig
00145 
00146             IF (sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
00147                ig_orig_type .eq. PSMILE_comp) THEN
00148               
00149                Number_of_comms = Number_of_comms + 1
00150 
00151                ila_trans_array(Number_of_comms,1) = sga_smioc_transi(ib)% &
00152                   sg_transi_in%sga_in_orig(ib_bis)%ig_transi_in_id
00153                ila_trans_array(Number_of_comms,2) = sga_smioc_transi(ib)% &
00154                   sg_transi_in%sga_in_orig(ib_bis)%ig_orig_transi_id
00155                ila_trans_array(Number_of_comms,3) = sga_smioc_transi(ib)% &
00156                   ig_comp_id
00157                ila_trans_array(Number_of_comms,8) = sga_smioc_transi(ib)% &
00158                   sg_transi_in%sga_in_orig(ib_bis)%ig_conserv
00159                ! be careful with the components 'file'
00160                IF (sga_smioc_transi(ib)% &
00161                   sg_transi_in%sga_in_orig(ib_bis)%ig_orig_comp_id .gt. 0) THEN
00162                      ila_trans_array(Number_of_comms,4) = sga_smioc_transi(ib)% &
00163                         sg_transi_in%sga_in_orig(ib_bis)%ig_orig_comp_id
00164                ELSE
00165                      ila_trans_array(Number_of_comms,4) = 0
00166                END IF
00167                ila_trans_array(Number_of_comms,5) = sga_smioc_transi(ib)% &
00168                   ig_datatype
00169 
00170                IF (sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
00171                   sg_interp%ig_interp_type .ne. PSMILe_undef) THEN
00172                      Number_of_Interps = Number_of_Interps + 1
00173                      ila_trans_array(Number_of_comms,6) = Number_of_Interps
00174                END IF
00175 
00176             END IF
00177 
00178          END DO
00179 
00180          IF (sga_smioc_transi(ib)%sg_transi_in%sg_tgt_local_trans% &
00181             ig_gather .ne. PSMILe_undef) THEN
00182               Number_of_Transfs = Number_of_Transfs + 1
00183          END IF
00184 
00185 
00186       END IF
00187 
00188    END DO
00189 
00190    DO ib = 1, ig_nb_tot_transi
00191     
00192       IF (sga_smioc_transi(ib)%ig_nb_transi_out .ne. 0) THEN
00193         
00194          DO ib_bis = 1, sga_smioc_transi(ib)%ig_nb_transi_out
00195 
00196             DO ib_ter = 1, Number_of_comms
00197 
00198                IF (ila_trans_array(ib_ter,1) .eq. sga_smioc_transi(ib)% &
00199                   sga_transi_out(ib_bis)%ig_dest_transi_id) THEN
00200 
00201                   IF (ila_trans_array(ib_ter,2) .eq. sga_smioc_transi(ib)% &
00202                      sga_transi_out(ib_bis)%ig_transi_out_id) THEN
00203 
00204                      IF (ila_trans_array(ib_ter,3) .eq. sga_smioc_transi(ib)%&
00205                         sga_transi_out(ib_bis)%ig_dest_comp_id) THEN
00206 
00207                            IF (ila_trans_array(ib_ter,4) .eq. &
00208                               sga_smioc_transi(ib)%ig_comp_id) THEN
00209                             
00210                               ila_trans_array(ib_ter,7) = 1
00211 
00212                            END IF
00213 
00214                      END IF
00215 
00216                   END IF
00217 
00218                END IF
00219 
00220             END DO
00221 
00222          END DO
00223 
00224       END IF
00225 
00226    END DO
00227 
00228 #ifdef VERBOSE
00229    PRINT *, '| | Number of exchanges of transients : ', Number_of_comms
00230    call psmile_flushstd
00231    PRINT *, '| | Number of interpolations : ', Number_of_Interps
00232    call psmile_flushstd
00233    PRINT *, '| | Number of transformations : ', Number_of_Transfs
00234    call psmile_flushstd
00235 #endif
00236 
00237    ! 3.2. Allocate the interpolations and transformations tables
00238    ALLOCATE(Drv_Interps(Number_of_Interps), stat = id_err)
00239    IF (id_err > 0) THEN
00240          ierrp (1) = id_err
00241          ierrp (2) = Number_of_Interps
00242          id_err = 13
00243 
00244          call psmile_error_common ( id_err, 'Drv_Interps', &
00245             ierrp, 2, __FILE__, __LINE__ )
00246          RETURN
00247    ENDIF
00248    ALLOCATE(Drv_Transfs(Number_of_Transfs), stat = id_err)
00249    IF (id_err > 0) THEN
00250          ierrp (1) = id_err
00251          ierrp (2) = Number_of_Transfs
00252          id_err = 13
00253 
00254          call psmile_error_common ( id_err, 'Drv_Transfs', &
00255             ierrp, 2, __FILE__, __LINE__ )
00256          RETURN
00257    ENDIF
00258 
00259    ! 3.3. set Number_of_Exchanges (the difference with the Number_of_comms is that
00260    !      Number_of_Exchanges takes into account the number of processes of the
00261    !      components
00262    Number_of_Exchanges = 0
00263 
00264    ALLOCATE(ila_comp_nb_pes3(Number_of_comms))
00265    ALLOCATE(ila_comp_nb_pes4(Number_of_comms))
00266 
00267    ila_comp_nb_pes3 = 0
00268    ila_comp_nb_pes4 = 0
00269 
00270    DO ib = 1, Number_of_comms
00271 
00272    !rr Modified to support stand alone applications which are run with a driver
00273    !rr
00274    !rr il_begin = SUM(iga_appli_compnbranksets(1:ila_trans_array(ib,3)-1))+1
00275 
00276       IF ( ila_trans_array(ib,3) > 1 ) THEN
00277          il_index = ila_trans_array(ib,3)
00278          il_begin = SUM(iga_appli_compnbranksets(1:ila_trans_array(ib,3)-1))+1
00279       ELSE
00280          il_index = 1
00281          il_begin = 1
00282       ENDIF
00283 
00284       DO ib_bis = il_begin, il_begin+iga_appli_compnbranksets(il_index)-1
00285          DO ib_ter = iga_appli_compranks(ib_bis,1), iga_appli_compranks(ib_bis,2), iga_appli_compranks(ib_bis,3)
00286          ila_comp_nb_pes3(ib) = ila_comp_nb_pes3 (ib)+ 1
00287          ENDDO
00288       ENDDO
00289 
00290    !rr Modified to support stand alone applications which are run with a driver
00291    !rr
00292    !rr il_begin = SUM(iga_appli_compnbranksets(1:ila_trans_array(ib,4)-1))+1
00293 
00294       IF ( ila_trans_array(ib,4) > 1 ) THEN
00295          il_index = ila_trans_array(ib,4)
00296          il_begin = SUM(iga_appli_compnbranksets(1:ila_trans_array(ib,4)-1))+1
00297       ELSE
00298          il_index = 1
00299          il_begin = 1
00300       ENDIF
00301 
00302       DO ib_bis = il_begin, il_begin+iga_appli_compnbranksets(il_index)-1
00303          DO ib_ter = iga_appli_compranks(ib_bis,1), iga_appli_compranks(ib_bis,2), iga_appli_compranks(ib_bis,3)
00304          ila_comp_nb_pes4(ib) = ila_comp_nb_pes4(ib) + 1
00305          ENDDO
00306       ENDDO
00307 
00308       Number_of_Exchanges = Number_of_Exchanges + ila_comp_nb_pes3(ib) * ila_comp_nb_pes4(ib)
00309 
00310    END DO
00311 #ifdef VERBOSE
00312    PRINT *, '| | Number of proc to proc exchanges of transients : ', &
00313       Number_of_Exchanges
00314    call psmile_flushstd
00315 #endif
00316    !
00317    ! 4. Initialize and set the exchanges and interpolations structures
00318    !
00319    ! 4.1. Allocate the exchanges structure
00320    ALLOCATE(Drv_Exchanges(Number_of_Exchanges), stat = id_err)
00321    IF (id_err > 0) THEN
00322          ierrp (1) = id_err
00323          ierrp (2) = Number_of_Exchanges
00324          id_err = 13
00325 
00326          call psmile_error_common ( id_err, 'Drv_Exchanges', &
00327             ierrp, 2, __FILE__, __LINE__ )
00328          RETURN
00329    ENDIF
00330 
00331    ! 4.2. Fill the structures with the smioc informations
00332    il_exchange_id = 0
00333    il_interp_id = 0
00334 
00335    DO ib = 1, Number_of_comms
00336       DO ib_bis = 1, ila_comp_nb_pes3(ib) * ila_comp_nb_pes4(ib)
00337 
00338          il_exchange_id = il_exchange_id + 1
00339 
00340          Drv_Exchanges(il_exchange_id)%trans_out_id = ila_trans_array(ib,2)
00341          Drv_Exchanges(il_exchange_id)%trans_in_id = ila_trans_array(ib,1)
00342          Drv_Exchanges(il_exchange_id)%conservation = ila_trans_array(ib,8)
00343          Drv_Exchanges(il_exchange_id)%trans_in_field_type = &
00344               ila_trans_array(ib,5)
00345          IF (ila_trans_array(ib,6) .ne. -1) THEN
00346             Drv_Exchanges(il_exchange_id)%interp_id = ila_trans_array(ib,6)
00347          ELSE
00348             Drv_Exchanges(il_exchange_id)%interp_id = PSMILe_trans_unset
00349          ENDIF
00350 
00351          CALL prismdrv_init_Drv_Exchange(il_exchange_id)
00352 
00353       END DO
00354 
00355    END DO
00356 
00357    DO ib = 1, ig_nb_tot_transi
00358 
00359       IF ((sga_smioc_transi(ib)%sg_transi_in%ig_nb_in_orig) .ne. 0) THEN
00360         
00361          DO ib_bis = 1, sga_smioc_transi(ib)%sg_transi_in%ig_nb_in_orig
00362 
00363             IF (sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
00364                sg_interp%ig_interp_type .ne. PSMILe_undef) THEN
00365 
00366                 il_interp_id = il_interp_id + 1
00367 
00368                 Drv_Interps(il_interp_id)%interp_id = il_interp_id
00369                 Drv_Interps(il_interp_id)%interp_type = sga_smioc_transi(ib)% &
00370                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%ig_interp_type
00371                 ! dd 2003/12/31 not the right dimension !
00372                 Drv_Interps(il_interp_id)%interp_method(:) =           &
00373                sga_smioc_transi(ib)%sg_transi_in%                  &
00374                    sga_in_orig(ib_bis)%sg_interp%iga_interp_meth(:)
00375                 Drv_Interps(il_interp_id)%arg1 = sga_smioc_transi(ib)% &
00376                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg1
00377                 Drv_Interps(il_interp_id)%arg2 = sga_smioc_transi(ib)% &
00378                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg2
00379                 Drv_Interps(il_interp_id)%arg3 = sga_smioc_transi(ib)% &
00380                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg3
00381                 Drv_Interps(il_interp_id)%arg4 = sga_smioc_transi(ib)% &
00382                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg4
00383                 Drv_Interps(il_interp_id)%arg5 = sga_smioc_transi(ib)% &
00384                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg5
00385                 Drv_Interps(il_interp_id)%arg6 = sga_smioc_transi(ib)% &
00386                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg6
00387                 Drv_Interps(il_interp_id)%arg7 = sga_smioc_transi(ib)% &
00388                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%iga_arg7
00389                 Drv_Interps(il_interp_id)%arg8 = sga_smioc_transi(ib)% &
00390                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%dg_arg8
00391                 Drv_Interps(il_interp_id)%arg9 = sga_smioc_transi(ib)% &
00392                    sg_transi_in%sga_in_orig(ib_bis)%sg_interp%cg_arg9
00393                 ! dd 2003/12/31 should be set for all the sub-structure !
00394   !                Drv_Interps(il_interp_id)%arg10 = sga_smioc_transi(ib)% &
00395   !                   sg_transi_in%sga_in_orig(ib_bis)%sg_interp%sg_arg10
00396 
00397              END IF
00398 
00399           END DO
00400 
00401        END IF
00402   
00403     END DO 
00404 #ifdef VERBOSE
00405    PRINT *, '| | '
00406    call psmile_flushstd
00407 #endif
00408    il_exchange_id = 0
00409    DO ib = 1, Number_of_comms
00410       DO ib_bis = 1, ila_comp_nb_pes3(ib) * ila_comp_nb_pes4(ib)
00411       
00412          il_exchange_id = il_exchange_id + 1
00413 #ifdef VERBOSE
00414          PRINT *, '| | | Exchange done between trans_out ', &
00415             Drv_Exchanges(il_exchange_id)%trans_out_id, 'and trans_in ', &
00416             Drv_Exchanges(il_exchange_id)%trans_in_id
00417          PRINT *, '| | | Corresponding interpolation : ', &
00418             Drv_Exchanges(il_exchange_id)%interp_id
00419          PRINT *, '| | | Transient type : ', &
00420             Drv_Exchanges(il_exchange_id)%trans_in_field_type
00421          call psmile_flushstd
00422 #endif 
00423       END DO
00424    END DO
00425 #ifdef VERBOSE
00426    PRINT *, '| | '
00427    call psmile_flushstd
00428 #endif
00429    DEALLOCATE(ila_trans_array, stat=id_err)
00430    IF (id_err > 0) THEN
00431          ierrp (1) = id_err
00432          id_err = 14
00433 
00434          call psmile_error_common ( id_err, 'ila_trans_array', &
00435               ierrp, 1, __FILE__, __LINE__ )
00436          RETURN
00437    ENDIF
00438 
00439    DEALLOCATE(ila_comp_nb_pes3,ila_comp_nb_pes4)
00440    !
00441    ! 5. Deallocate the smioc structure
00442    !
00443    call prismdrv_finalize_smioc_struct(id_err)
00444 
00445    !
00446    !=======================================================================
00447    !
00448 #ifdef VERBOSE
00449    PRINT *, '| Quit PRISMDrv_set_smioc_info'
00450    PRINT *, '|'
00451    call psmile_flushstd
00452 #endif
00453 END IF  !(Appl%rank .eq. PRISM_root)
00454 
00455 end subroutine prismdrv_set_smioc_info
00456 
00457 
00458 
00459 
00460 
00461 
00462