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 15574 for NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/TRA/trasbc.F90 – NEMO

Ignore:
Timestamp:
2021-12-03T20:32:50+01:00 (12 months ago)
Author:
techene
Message:

#2605 #2715 trunk merged into dev_r14318_RK3_stage1

Location:
NEMO/branches/2021/dev_r14318_RK3_stage1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14318_RK3_stage1

    • Property svn:externals
      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 
  • NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/TRA/trasbc.F90

    r15379 r15574  
    4040 
    4141   PUBLIC   tra_sbc       ! routine called by step.F90 
    42    PUBLIC   tra_sbc_RK3   ! routine called by stprk3_.F90 
     42   PUBLIC   tra_sbc_RK3   ! routine called by stprk3_stg.F90 
    4343 
    4444   !! * Substitutions 
     
    5252CONTAINS 
    5353 
    54    SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs, kstg ) 
     54   SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs ) 
    5555      !!---------------------------------------------------------------------- 
    5656      !!                  ***  ROUTINE tra_sbc  *** 
     
    7373      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T) 
    7474      !!---------------------------------------------------------------------- 
    75       INTEGER,                                   INTENT(in   ) ::   kt, Kmm, Krhs   ! ocean time-step and time-level indices 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts             ! active tracers and RHS of tracer Eq. 
    77       INTEGER , OPTIONAL                       , INTENT(in   ) ::   kstg            ! RK3 stage index 
     75      INTEGER,                                   INTENT(in   ) ::   kt         ! ocean time-step index 
     76      INTEGER,                                   INTENT(in   ) ::   Kmm, Krhs  ! time level indices 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts        ! active tracers and RHS of tracer Eq. 
    7878      ! 
    7979      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices 
    80       INTEGER  ::   istg_1, istg_3               ! local integers 
    81       INTEGER  ::   ikt, ikb, isi, iei, isj, iej !   -       - 
     80      INTEGER  ::   ikt, ikb                     ! local integers 
    8281      REAL(wp) ::   zfact, z1_e3t, zdep, ztim    ! local scalar 
    8382      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     
    8685      IF( ln_timing )   CALL timing_start('tra_sbc') 
    8786      ! 
    88       IF( PRESENT( kstg ) ) THEN      ! RK3 : a few things have to be done at only a specific stage 
    89          istg_1 = kstg   ;   istg_3 = kstg 
    90       ELSE                            ! MLF : only one call by time step 
    91          istg_1 =   1    ;   istg_3 =   3 
    92       ENDIF 
    93       ! 
    94       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     87      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    9588         IF( kt == nit000 ) THEN 
    9689            IF(lwp) WRITE(numout,*) 
     
    10699      ENDIF 
    107100      ! 
    108       IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    109       IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 
    110       IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 
    111       IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 
    112  
    113101!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    114       IF( .NOT.ln_traqsr .AND. istg_1 == 1 ) THEN     ! no solar radiation penetration (RK3: only at stage 1) 
    115          DO_2D( isi, iei, isj, iej ) 
    116             qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)         ! total heat flux in qns 
    117             qsr(ji,jj) = 0._wp                           ! qsr set to zero 
     102      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
     103         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     104            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
     105            qsr(ji,jj) = 0._wp                        ! qsr set to zero 
    118106         END_2D 
    119107      ENDIF 
     
    123111      !---------------------------------------- 
    124112      !                             !==  Set before sbc tracer content fields  ==! 
    125       zfact = 0.5_wp 
    126       IF( kt == nit000 .AND. istg_1 == 1 ) THEN             !* 1st time-step 
     113      IF( kt == nit000 ) THEN             !* 1st time-step 
    127114         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file 
    128             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     115            zfact = 0.5_wp 
     116            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    129117               IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file' 
    130118               sbc_tsc(:,:,:) = 0._wp 
     
    134122         ELSE                                             ! No restart or restart not found: Euler forward time stepping 
    135123            zfact = 1._wp 
    136             DO_2D( isi, iei, isj, iej ) 
     124            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    137125               sbc_tsc(ji,jj,:) = 0._wp 
    138126               sbc_tsc_b(ji,jj,:) = 0._wp 
    139127            END_2D 
    140128         ENDIF 
    141       ELSEIF( istg_3 == 3 ) THEN          !* other time-steps: swap of forcing fields (RK3: only at stage 3) 
     129      ELSE                                !* other time-steps: swap of forcing fields 
    142130         zfact = 0.5_wp 
    143          DO_2D( isi, iei, isj, iej ) 
     131         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    144132            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 
    145133         END_2D 
    146 #if defined key_RK3 
    147          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    148             IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==! 
    149                CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 
    150                CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 
    151             ENDIF 
    152          ENDIF 
    153 #endif 
    154134      ENDIF 
    155135      !                             !==  Now sbc tracer content fields  ==! 
    156       DO_2D( isi, iei, isj, iej ) 
     136      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    157137         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    158138         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    159139      END_2D 
    160140      IF( ln_linssh ) THEN                !* linear free surface 
    161          DO_2D( isi, iei, isj, iej )                    !==>> add concentration/dilution effect due to constant volume cell 
     141         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )                    !==>> add concentration/dilution effect due to constant volume cell 
    162142            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    163143            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
    164144         END_2D                                 !==>> output c./d. term 
    165          IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile 
    166             IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
    167             IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
    168          ENDIF 
     145         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
     146         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
    169147      ENDIF 
    170148      ! 
     
    176154      END DO 
    177155      ! 
    178 #if ! defined key_RK3 
    179       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     156      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    180157         IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==! 
    181158            CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 
     
    183160         ENDIF 
    184161      ENDIF 
    185 #endif 
    186162      ! 
    187163      !---------------------------------------- 
     
    193169         DO_2D( 0, 0, 0, 0 ) 
    194170            IF( rnf(ji,jj) /= 0._wp ) THEN 
    195 !!st - Jerome               zdep = zfact / h_rnf(ji,jj) 
    196 #if defined key_RK3 
    197                zdep = 1._wp / h_rnf(ji,jj) 
    198                DO jk = 1, nk_rnf(ji,jj) 
    199                                      pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)  + rnf_tsc(ji,jj,jp_tem) * zdep 
    200                   IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)  + rnf_tsc(ji,jj,jp_sal) * zdep 
    201                END DO 
    202  
    203 #else 
    204171               zdep = zfact / h_rnf(ji,jj) 
    205172               DO jk = 1, nk_rnf(ji,jj) 
     
    209176                                        &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
    210177               END DO 
    211 #endif 
    212 !!st 
    213178            ENDIF 
    214179         END_2D 
    215180      ENDIF 
    216181 
    217       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    218          IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
    219          IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
    220       ENDIF 
     182      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
     183      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
    221184 
    222185#if defined key_asminc 
     
    260223      ! 
    261224   END SUBROUTINE tra_sbc 
    262  
     225     
    263226 
    264227   SUBROUTINE tra_sbc_RK3 ( kt, Kmm, pts, Krhs, kstg ) 
Note: See TracChangeset for help on using the changeset viewer.