New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13982 for NEMO/trunk/src/OCE/IOM/prtctl.F90 – NEMO

Ignore:
Timestamp:
2020-12-02T11:57:05+01:00 (3 years ago)
Author:
smasson
Message:

trunk: merge dev_r13923_Tiling_Cleanup_MPI3_LoopFusion into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/IOM/prtctl.F90

    r13286 r13982  
    88   !!---------------------------------------------------------------------- 
    99   USE dom_oce          ! ocean space and time domain variables 
     10   USE domutl, ONLY : is_tile 
    1011   USE in_out_manager   ! I/O manager 
    1112   USE mppini           ! distributed memory computing 
     
    2627   PUBLIC prt_ctl_init    ! called by nemogcm.F90 and prt_ctl_trc_init 
    2728 
     29   !! * Substitutions 
     30#  include "do_loop_substitute.h90" 
    2831   !!---------------------------------------------------------------------- 
    2932   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3538   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2,   & 
    3639      &                 clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
     40      !! 
     41      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1 
     42      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1 
     43      REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1 
     44      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2 
     45      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2 
     46      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
     47      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
     48      CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array 
     49      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1 
     50      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo2 
     51      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo3 
     52      INTEGER                             , INTENT(in), OPTIONAL ::   kdim 
     53      ! 
     54      INTEGER :: itab2d_1, itab3d_1, itab4d_1, itab2d_2, itab3d_2 
     55      !! 
     56      IF( PRESENT(tab2d_1)  ) THEN ; itab2d_1 = is_tile(tab2d_1)  ; ELSE ; itab2d_1 = 0 ; ENDIF 
     57      IF( PRESENT(tab3d_1)  ) THEN ; itab3d_1 = is_tile(tab3d_1)  ; ELSE ; itab3d_1 = 0 ; ENDIF 
     58      IF( PRESENT(tab4d_1)  ) THEN ; itab4d_1 = is_tile(tab4d_1)  ; ELSE ; itab4d_1 = 0 ; ENDIF 
     59      IF( PRESENT(tab2d_2)  ) THEN ; itab2d_2 = is_tile(tab2d_2)  ; ELSE ; itab2d_2 = 0 ; ENDIF 
     60      IF( PRESENT(tab3d_2)  ) THEN ; itab3d_2 = is_tile(tab3d_2)  ; ELSE ; itab3d_2 = 0 ; ENDIF 
     61 
     62      CALL prt_ctl_t (tab2d_1, itab2d_1, tab3d_1, itab3d_1, tab4d_1, itab4d_1, tab2d_2, itab2d_2, tab3d_2, itab3d_2,  & 
     63      &               mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
     64   END SUBROUTINE prt_ctl 
     65 
     66 
     67   SUBROUTINE prt_ctl_t (tab2d_1, ktab2d_1, tab3d_1, ktab3d_1, tab4d_1, ktab4d_1, tab2d_2, ktab2d_2, tab3d_2, ktab3d_2,  & 
     68      &                  mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
    3769      !!---------------------------------------------------------------------- 
    3870      !!                     ***  ROUTINE prt_ctl  *** 
     
    70102      !!                    clinfo3 : additional information  
    71103      !!---------------------------------------------------------------------- 
    72       REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1 
    73       REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1 
    74       REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1 
    75       REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2 
    76       REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2 
     104      INTEGER                             , INTENT(in)           ::   ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2 
     105      REAL(wp),         DIMENSION(A2D_T(ktab2d_1))    , INTENT(in), OPTIONAL ::   tab2d_1 
     106      REAL(wp),         DIMENSION(A2D_T(ktab3d_1),:)  , INTENT(in), OPTIONAL ::   tab3d_1 
     107      REAL(wp),         DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL ::   tab4d_1 
     108      REAL(wp),         DIMENSION(A2D_T(ktab2d_2))    , INTENT(in), OPTIONAL ::   tab2d_2 
     109      REAL(wp),         DIMENSION(A2D_T(ktab3d_2),:)  , INTENT(in), OPTIONAL ::   tab3d_2 
    77110      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
    78111      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
     
    106139 
    107140         ! define shoter names... 
    108          iis = nall_ictls(jl) 
    109          iie = nall_ictle(jl) 
    110          jjs = nall_jctls(jl) 
    111          jje = nall_jctle(jl) 
     141         iis = MAX( nall_ictls(jl), ntsi ) 
     142         iie = MIN( nall_ictle(jl), ntei ) 
     143         jjs = MAX( nall_jctls(jl), ntsj ) 
     144         jje = MIN( nall_jctle(jl), ntej ) 
    112145 
    113146         IF( PRESENT(clinfo) ) THEN   ;   inum = numprt_top(jl) 
     
    115148         ENDIF 
    116149 
    117          DO jn = 1, itra 
    118  
    119             IF( PRESENT(clinfo3) ) THEN 
    120                IF    ( clinfo3 == 'tra-ta' )   THEN 
    121                   zvctl1 = t_ctl(jl) 
    122                ELSEIF( clinfo3 == 'tra'    )   THEN 
    123                   zvctl1 = t_ctl(jl) 
    124                   zvctl2 = s_ctl(jl) 
    125                ELSEIF( clinfo3 == 'dyn'    )   THEN 
    126                   zvctl1 = u_ctl(jl) 
    127                   zvctl2 = v_ctl(jl) 
     150         ! Compute the sum control only where the tile domain and control print area overlap 
     151         IF( iie >= iis .AND. jje >= jjs ) THEN 
     152            DO jn = 1, itra 
     153 
     154               IF( PRESENT(clinfo3) ) THEN 
     155                  IF    ( clinfo3 == 'tra-ta' )   THEN 
     156                     zvctl1 = t_ctl(jl) 
     157                  ELSEIF( clinfo3 == 'tra'    )   THEN 
     158                     zvctl1 = t_ctl(jl) 
     159                     zvctl2 = s_ctl(jl) 
     160                  ELSEIF( clinfo3 == 'dyn'    )   THEN 
     161                     zvctl1 = u_ctl(jl) 
     162                     zvctl2 = v_ctl(jl) 
     163                  ELSE 
     164                     zvctl1 = tra_ctl(jn,jl) 
     165                  ENDIF 
     166               ENDIF 
     167 
     168               ! 2D arrays 
     169               IF( PRESENT(tab2d_1) ) THEN 
     170                  IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 
     171                  ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            ) 
     172                  ENDIF 
     173               ENDIF 
     174               IF( PRESENT(tab2d_2) ) THEN 
     175                  IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 
     176                  ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            ) 
     177                  ENDIF 
     178               ENDIF 
     179 
     180               ! 3D arrays 
     181               IF( PRESENT(tab3d_1) ) THEN 
     182                  IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     183                  ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 ) 
     184                  ENDIF 
     185               ENDIF 
     186               IF( PRESENT(tab3d_2) ) THEN 
     187                  IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 
     188                  ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 ) 
     189                  ENDIF 
     190               ENDIF 
     191 
     192               ! 4D arrays 
     193               IF( PRESENT(tab4d_1) ) THEN 
     194                  IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     195                  ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 ) 
     196                  ENDIF 
     197               ENDIF 
     198 
     199               ! Print the result 
     200               IF( PRESENT(clinfo ) )   cl1  = clinfo(jn) 
     201               IF( PRESENT(clinfo3) )   THEN 
     202                  ! 
     203                  IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 
     204                     WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
     205                  ELSE 
     206                     WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1 
     207                  ENDIF 
     208                  ! 
     209                  SELECT CASE( clinfo3 ) 
     210                  CASE ( 'tra-ta' ) 
     211                     t_ctl(jl) = zsum1 
     212                  CASE ( 'tra' ) 
     213                     t_ctl(jl) = zsum1 
     214                     s_ctl(jl) = zsum2 
     215                  CASE ( 'dyn' ) 
     216                     u_ctl(jl) = zsum1 
     217                     v_ctl(jl) = zsum2 
     218                  CASE default 
     219                     tra_ctl(jn,jl) = zsum1 
     220                  END SELECT 
     221               ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
     222                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 
    128223               ELSE 
    129                   zvctl1 = tra_ctl(jn,jl) 
    130                ENDIF 
    131             ENDIF 
    132  
    133             ! 2D arrays 
    134             IF( PRESENT(tab2d_1) ) THEN 
    135                IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 
    136                ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            ) 
    137                ENDIF 
    138             ENDIF 
    139             IF( PRESENT(tab2d_2) ) THEN 
    140                IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 
    141                ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            ) 
    142                ENDIF 
    143             ENDIF 
    144  
    145             ! 3D arrays 
    146             IF( PRESENT(tab3d_1) ) THEN 
    147                IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 
    148                ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 ) 
    149                ENDIF 
    150             ENDIF 
    151             IF( PRESENT(tab3d_2) ) THEN 
    152                IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 
    153                ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 ) 
    154                ENDIF 
    155             ENDIF 
    156  
    157             ! 4D arrays 
    158             IF( PRESENT(tab4d_1) ) THEN 
    159                IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 
    160                ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 ) 
    161                ENDIF 
    162             ENDIF 
    163  
    164             ! Print the result 
    165             IF( PRESENT(clinfo ) )   cl1  = clinfo(jn) 
    166             IF( PRESENT(clinfo3) )   THEN 
    167                ! 
    168                IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 
    169                   WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
    170                ELSE 
    171                   WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1 
    172                ENDIF 
    173                ! 
    174                SELECT CASE( clinfo3 ) 
    175                CASE ( 'tra-ta' )  
    176                   t_ctl(jl) = zsum1 
    177                CASE ( 'tra' )  
    178                   t_ctl(jl) = zsum1 
    179                   s_ctl(jl) = zsum2 
    180                CASE ( 'dyn' )  
    181                   u_ctl(jl) = zsum1 
    182                   v_ctl(jl) = zsum2 
    183                CASE default 
    184                   tra_ctl(jn,jl) = zsum1 
    185                END SELECT 
    186             ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
    187                WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 
    188             ELSE 
    189                WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 
    190             ENDIF 
    191  
    192          END DO 
     224                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 
     225               ENDIF 
     226 
     227            END DO 
     228         ENDIF 
    193229      END DO 
    194230      ! 
    195    END SUBROUTINE prt_ctl 
     231   END SUBROUTINE prt_ctl_t 
    196232 
    197233 
Note: See TracChangeset for help on using the changeset viewer.