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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DIA/diacfl.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DIA/diacfl.F90

    r10824 r13463  
    2929   REAL(wp)              ::   rCu_max, rCv_max, rCw_max   ! associated run max Courant number  
    3030 
    31 !!gm CAUTION: need to declare these arrays here, otherwise the calculation fails in multi-proc ! 
    32 !!gm          I don't understand why. 
    33    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
    34 !!gm end 
    35  
    3631   PUBLIC   dia_cfl       ! routine called by step.F90 
    3732   PUBLIC   dia_cfl_init  ! routine called by nemogcm 
    3833 
    3934   !! * Substitutions 
    40 #  include "vectopt_loop_substitute.h90" 
     35#  include "do_loop_substitute.h90" 
     36#  include "domzgr_substitute.h90" 
    4137   !!---------------------------------------------------------------------- 
    4238   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4642CONTAINS 
    4743 
    48    SUBROUTINE dia_cfl ( kt ) 
     44   SUBROUTINE dia_cfl ( kt, Kmm ) 
    4945      !!---------------------------------------------------------------------- 
    5046      !!                  ***  ROUTINE dia_cfl  *** 
    … …  
    5450      !!---------------------------------------------------------------------- 
    5551      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     52      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    5653      ! 
    57       INTEGER                ::   ji, jj, jk                            ! dummy loop indices 
    58       REAL(wp)               ::   z2dt, zCu_max, zCv_max, zCw_max       ! local scalars 
    59       INTEGER , DIMENSION(3) ::   iloc_u , iloc_v , iloc_w , iloc       ! workspace 
    60 !!gm this does not work      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
     54      INTEGER                          ::   ji, jj, jk                       ! dummy loop indices 
     55      REAL(wp)                         ::   zCu_max, zCv_max, zCw_max        ! local scalars 
     56      INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc  ! workspace 
     57      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl        ! workspace 
     58      LOGICAL , DIMENSION(jpi,jpj,jpk) ::   llmsk 
    6159      !!---------------------------------------------------------------------- 
    6260      ! 
    6361      IF( ln_timing )   CALL timing_start('dia_cfl') 
    6462      ! 
    65       !                       ! setup timestep multiplier to account for initial Eulerian timestep 
    66       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2dt = rdt 
    67       ELSE                                        ;    z2dt = rdt * 2._wp 
    68       ENDIF 
     63      llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
     64      llmsk(Nie1: jpi,:,:) = .FALSE. 
     65      llmsk(:,   1:Njs1,:) = .FALSE. 
     66      llmsk(:,Nje1: jpj,:) = .FALSE. 
    6967      ! 
    70       !                 
    71       DO jk = 1, jpk       ! calculate Courant numbers 
    72          DO jj = 1, jpj 
    73             DO ji = 1, fs_jpim1   ! vector opt. 
    74                zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
    75                zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
    76                zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction 
    77             END DO 
    78          END DO          
    79       END DO 
     68      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     69         zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u  (ji,jj)      ! for i-direction 
     70         zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * rDt / e2v  (ji,jj)      ! for j-direction 
     71         zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * rDt / e3w(ji,jj,jk,Kmm)     ! for k-direction 
     72      END_3D 
    8073      ! 
    8174      ! write outputs 
    82       IF( iom_use('cfl_cu') )   CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, dim=3 ) ) 
    83       IF( iom_use('cfl_cv') )   CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, dim=3 ) ) 
    84       IF( iom_use('cfl_cw') )   CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, dim=3 ) ) 
     75      IF( iom_use('cfl_cu') ) THEN 
     76         llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     77         CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, mask = llmsk, dim=3 ) ) 
     78      ENDIF 
     79      IF( iom_use('cfl_cv') ) THEN 
     80         llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     81         CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, mask = llmsk, dim=3 ) ) 
     82      ENDIF 
     83      IF( iom_use('cfl_cw') ) THEN 
     84         llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     85         CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, mask = llmsk, dim=3 ) ) 
     86      ENDIF 
    8587 
    8688      !                    ! calculate maximum values and locations 
    87       IF( lk_mpp ) THEN 
    88          CALL mpp_maxloc( 'diacfl', zCu_cfl, umask, zCu_max, iloc_u ) 
    89          CALL mpp_maxloc( 'diacfl', zCv_cfl, vmask, zCv_max, iloc_v ) 
    90          CALL mpp_maxloc( 'diacfl', zCw_cfl, wmask, zCw_max, iloc_w ) 
    91       ELSE 
    92          iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 
    93          iloc_u(1) = iloc(1) + nimpp - 1 
    94          iloc_u(2) = iloc(2) + njmpp - 1 
    95          iloc_u(3) = iloc(3) 
    96          zCu_max = zCu_cfl(iloc(1),iloc(2),iloc(3)) 
    97          ! 
    98          iloc = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 
    99          iloc_v(1) = iloc(1) + nimpp - 1 
    100          iloc_v(2) = iloc(2) + njmpp - 1 
    101          iloc_v(3) = iloc(3) 
    102          zCv_max = zCv_cfl(iloc(1),iloc(2),iloc(3)) 
    103          ! 
    104          iloc = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 
    105          iloc_w(1) = iloc(1) + nimpp - 1 
    106          iloc_w(2) = iloc(2) + njmpp - 1 
    107          iloc_w(3) = iloc(3) 
    108          zCw_max = zCw_cfl(iloc(1),iloc(2),iloc(3)) 
    109       ENDIF 
     89      llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     90      CALL mpp_maxloc( 'diacfl', zCu_cfl, llmsk, zCu_max, iloc_u ) 
     91      llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     92      CALL mpp_maxloc( 'diacfl', zCv_cfl, llmsk, zCv_max, iloc_v ) 
     93      llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     94      CALL mpp_maxloc( 'diacfl', zCw_cfl, llmsk, zCw_max, iloc_w ) 
    11095      ! 
    111       !                    ! write out to file 
    112       IF( lwp ) THEN 
    113          WRITE(numcfl,FMT='(2x,i4,5x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
     96      IF( lwp ) THEN       ! write out to file 
     97         WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
    11498         WRITE(numcfl,FMT='(11x,     a6,4x,f7.4,1x,i4,1x,i4,1x,i4)')     'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 
    11599         WRITE(numcfl,FMT='(11x,     a6,4x,f7.4,1x,i4,1x,i4,1x,i4)')     'Max Cw', zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) 
    … …  
    126110         WRITE(numcfl,*) '******************************************' 
    127111         WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3) 
    128          WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max 
     112         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCu_max 
    129113         WRITE(numcfl,*) '******************************************' 
    130114         WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3) 
    131          WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max 
     115         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCv_max 
    132116         WRITE(numcfl,*) '******************************************' 
    133117         WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3) 
    134          WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max 
     118         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCw_max 
    135119         CLOSE( numcfl )  
    136120         ! 
    … …  
    139123         WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 
    140124         WRITE(numout,*) '~~~~~~~' 
    141          WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max 
    142          WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max 
    143          WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max 
     125         WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', rDt/rCu_max 
     126         WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', rDt/rCv_max 
     127         WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', rDt/rCw_max 
    144128      ENDIF 
    145129      ! 
    … …  
    172156      rCw_max = 0._wp 
    173157      ! 
    174 !!gm required to work 
    175       ALLOCATE ( zCu_cfl(jpi,jpj,jpk), zCv_cfl(jpi,jpj,jpk), zCw_cfl(jpi,jpj,jpk) ) 
    176 !!gm end 
    177       !       
    178158   END SUBROUTINE dia_cfl_init 
    179159 
Note: See TracChangeset for help on using the changeset viewer.