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 12680 – NEMO

Changeset 12680


Ignore:
Timestamp:
2020-04-03T18:54:55+02:00 (4 years ago)
Author:
techene
Message:

dynatfQCO.F90, stepLF.F90 : fixed (remove pe3. from dyn_atf_qco input arguments), all : remove e3. tables and include gurvan's feedbacks

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
Files:
43 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceistate.F90

    r12679 r12680  
    6060   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
    6161   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    62    ! 
     62 
    6363   !! * Substitutions 
    6464#  include "do_loop_substitute.h90" 
     
    102102      REAL(wp), DIMENSION(jpi,jpj)     ::   zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    103103      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini                       !data from namelist or nc file 
    104       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
     104      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !locak arrays 
    105105      !! 
    106106      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
     
    452452      !! 
    453453      !!----------------------------------------------------------------------------- 
    454       INTEGER ::   ios   ! Local integer output status for namelist read 
    455       INTEGER ::   ifpr, ierror 
     454      INTEGER ::   ios, ifpr, ierror   ! Local integers 
     455 
    456456      ! 
    457457      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90

    r12656 r12680  
    99   !!                 ! 2007-04  (A. Weaver)  Merge with OPAVAR/NEMOVAR 
    1010   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2 
    11    !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
     11   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init 
    1212   !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization 
    1313   !!                 ! 2014-09  (D. Lea)  Local calc_date removed use routine from OBS 
     
    3131   USE zpshde          ! Partial step : Horizontal Derivative 
    3232   USE asmpar          ! Parameters for the assmilation interface 
    33    USE asmbkg          !  
     33   USE asmbkg          ! 
    3434   USE c1d             ! 1D initialization 
    3535   USE sbc_oce         ! Surface boundary condition variables. 
     
    4545   IMPLICIT NONE 
    4646   PRIVATE 
    47     
     47 
    4848   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
    4949   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
     
    7272   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkg   , v_bkg      !: Background u- & v- velocity components 
    7373   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkginc, s_bkginc   !: Increment to the background T & S 
    74    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components  
     74   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components 
    7575   REAL(wp), PUBLIC, DIMENSION(:)    , ALLOCATABLE ::   wgtiau               !: IAU weights for each time step 
    7676#if defined key_asminc 
     
    8080   INTEGER , PUBLIC ::   nitbkg      !: Time step of the background state used in the Jb term 
    8181   INTEGER , PUBLIC ::   nitdin      !: Time step of the background state for direct initialization 
    82    INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
     82   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval 
    8383   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval 
    84    !  
     84   ! 
    8585   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
    86    !                                 !: = 1   Linear hat-like, centred in middle of IAU interval  
     86   !                                 !: = 1   Linear hat-like, centred in middle of IAU interval 
    8787   REAL(wp), PUBLIC ::   salfixmin   !: Ensure that the salinity is larger than this  value if (ln_salfix) 
    8888 
     
    106106      !!---------------------------------------------------------------------- 
    107107      !!                    ***  ROUTINE asm_inc_init  *** 
    108       !!           
     108      !! 
    109109      !! ** Purpose : Initialize the assimilation increment and IAU weights. 
    110110      !! 
    111111      !! ** Method  : Initialize the assimilation increment and IAU weights. 
    112112      !! 
    113       !! ** Action  :  
     113      !! ** Action  : 
    114114      !!---------------------------------------------------------------------- 
    115115      INTEGER, INTENT(in) ::  Kbb, Kmm, Krhs  ! time level indices 
     
    263263         ! 
    264264         !                                !--------------------------------------------------------- 
    265          IF( niaufn == 0 ) THEN           ! Constant IAU forcing  
     265         IF( niaufn == 0 ) THEN           ! Constant IAU forcing 
    266266            !                             !--------------------------------------------------------- 
    267267            DO jt = 1, iiauper 
     
    269269            END DO 
    270270            !                             !--------------------------------------------------------- 
    271          ELSEIF ( niaufn == 1 ) THEN      ! Linear hat-like, centred in middle of IAU interval  
     271         ELSEIF ( niaufn == 1 ) THEN      ! Linear hat-like, centred in middle of IAU interval 
    272272            !                             !--------------------------------------------------------- 
    273273            ! Compute the normalization factor 
    274274            znorm = 0._wp 
    275275            IF( MOD( iiauper, 2 ) == 0 ) THEN   ! Even number of time steps in IAU interval 
    276                imid = iiauper / 2  
     276               imid = iiauper / 2 
    277277               DO jt = 1, imid 
    278278                  znorm = znorm + REAL( jt ) 
     
    280280               znorm = 2.0 * znorm 
    281281            ELSE                                ! Odd number of time steps in IAU interval 
    282                imid = ( iiauper + 1 ) / 2         
     282               imid = ( iiauper + 1 ) / 2 
    283283               DO jt = 1, imid - 1 
    284284                  znorm = znorm + REAL( jt ) 
     
    307307             DO jt = 1, icycper 
    308308                ztotwgt = ztotwgt + wgtiau(jt) 
    309                 WRITE(numout,*) '         ', jt, '       ', wgtiau(jt)  
    310              END DO    
     309                WRITE(numout,*) '         ', jt, '       ', wgtiau(jt) 
     310             END DO 
    311311             WRITE(numout,*) '         ===================================' 
    312312             WRITE(numout,*) '         Time-integrated weight = ', ztotwgt 
    313313             WRITE(numout,*) '         ===================================' 
    314314          ENDIF 
    315           
     315 
    316316      ENDIF 
    317317 
     
    338338         CALL iom_open( c_asminc, inum ) 
    339339         ! 
    340          CALL iom_get( inum, 'time'       , zdate_inc   )  
     340         CALL iom_get( inum, 'time'       , zdate_inc   ) 
    341341         CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb ) 
    342342         CALL iom_get( inum, 'z_inc_datef', z_inc_datef ) 
     
    345345         ! 
    346346         IF(lwp) THEN 
    347             WRITE(numout,*)  
     347            WRITE(numout,*) 
    348348            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid between dates ', z_inc_dateb,' and ', z_inc_datef 
    349349            WRITE(numout,*) '~~~~~~~~~~~~' 
     
    359359            &                ' not agree with Direct Initialization time' ) 
    360360 
    361          IF ( ln_trainc ) THEN    
     361         IF ( ln_trainc ) THEN 
    362362            CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 ) 
    363363            CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 ) 
     
    371371         ENDIF 
    372372 
    373          IF ( ln_dyninc ) THEN    
    374             CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 )               
    375             CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 )               
     373         IF ( ln_dyninc ) THEN 
     374            CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 ) 
     375            CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 ) 
    376376            ! Apply the masks 
    377377            u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:) 
     
    382382            WHERE( ABS( v_bkginc(:,:,:) ) > 1.0e+10 ) v_bkginc(:,:,:) = 0.0 
    383383         ENDIF 
    384          
     384 
    385385         IF ( ln_sshinc ) THEN 
    386386            CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 ) 
     
    408408      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN    ! Apply divergence damping filter 
    409409         !                                         !-------------------------------------- 
    410          ALLOCATE( zhdiv(jpi,jpj) )  
     410         ALLOCATE( zhdiv(jpi,jpj) ) 
    411411         ! 
    412412         DO jt = 1, nn_divdmp 
     
    427427                     &               + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    428428                  v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         & 
    429                      &               + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
     429                     &               + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    430430               END_2D 
    431431            END DO 
     
    433433         END DO 
    434434         ! 
    435          DEALLOCATE( zhdiv )  
     435         DEALLOCATE( zhdiv ) 
    436436         ! 
    437437      ENDIF 
     
    454454         CALL iom_open( c_asmdin, inum ) 
    455455         ! 
    456          CALL iom_get( inum, 'rdastp', zdate_bkg )  
     456         CALL iom_get( inum, 'rdastp', zdate_bkg ) 
    457457         ! 
    458458         IF(lwp) THEN 
    459             WRITE(numout,*)  
     459            WRITE(numout,*) 
    460460            WRITE(numout,*) '   ==>>>  Assimilation background state valid at : ', zdate_bkg 
    461461            WRITE(numout,*) 
     
    466466            &                ' not agree with Direct Initialization time' ) 
    467467         ! 
    468          IF ( ln_trainc ) THEN    
     468         IF ( ln_trainc ) THEN 
    469469            CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg ) 
    470470            CALL iom_get( inum, jpdom_autoglo, 'sn', s_bkg ) 
     
    473473         ENDIF 
    474474         ! 
    475          IF ( ln_dyninc ) THEN    
     475         IF ( ln_dyninc ) THEN 
    476476            CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg ) 
    477477            CALL iom_get( inum, jpdom_autoglo, 'vn', v_bkg ) 
     
    501501      ! 
    502502   END SUBROUTINE asm_inc_init 
    503     
    504     
     503 
     504 
    505505   SUBROUTINE tra_asm_inc( kt, Kbb, Kmm, pts, Krhs ) 
    506506      !!---------------------------------------------------------------------- 
    507507      !!                    ***  ROUTINE tra_asm_inc  *** 
    508       !!           
     508      !! 
    509509      !! ** Purpose : Apply the tracer (T and S) assimilation increments 
    510510      !! 
    511511      !! ** Method  : Direct initialization or Incremental Analysis Updating 
    512512      !! 
    513       !! ** Action  :  
     513      !! ** Action  : 
    514514      !!---------------------------------------------------------------------- 
    515515      INTEGER                                  , INTENT(in   ) :: kt             ! Current time step 
     
    523523      !!---------------------------------------------------------------------- 
    524524      ! 
    525       ! freezing point calculation taken from oc_fz_pt (but calculated for all depths)  
    526       ! used to prevent the applied increments taking the temperature below the local freezing point  
     525      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 
     526      ! used to prevent the applied increments taking the temperature below the local freezing point 
    527527      DO jk = 1, jpkm1 
    528528        CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 
     
    539539            ! 
    540540            IF(lwp) THEN 
    541                WRITE(numout,*)  
     541               WRITE(numout,*) 
    542542               WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    543543               WRITE(numout,*) '~~~~~~~~~~~~' 
     
    549549                  ! Do not apply negative increments if the temperature will fall below freezing 
    550550                  WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. & 
    551                      &   pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )  
    552                      pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt   
     551                     &   pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 
     552                     pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 
    553553                  END WHERE 
    554554               ELSE 
    555                   pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt   
     555                  pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 
    556556               ENDIF 
    557557               IF (ln_salfix) THEN 
     
    559559                  ! minimum value salfixmin 
    560560                  WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. & 
    561                      &   pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )  
     561                     &   pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 
    562562                     pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 
    563563                  END WHERE 
     
    576576      ELSEIF ( ln_asmdin ) THEN        ! Direct Initialization 
    577577         !                             !-------------------------------------- 
    578          !             
     578         ! 
    579579         IF ( kt == nitdin_r ) THEN 
    580580            ! 
     
    584584            IF (ln_temnofreeze) THEN 
    585585               ! Do not apply negative increments if the temperature will fall below freezing 
    586                WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
    587                   pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     586               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 
     587                  pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 
    588588               END WHERE 
    589589            ELSE 
    590                pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     590               pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 
    591591            ENDIF 
    592592            IF (ln_salfix) THEN 
    593593               ! Do not apply negative increments if the salinity will fall below a specified 
    594594               ! minimum value salfixmin 
    595                WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )  
    596                   pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
     595               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 
     596                  pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 
    597597               END WHERE 
    598598            ELSE 
    599                pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
     599               pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 
    600600            ENDIF 
    601601 
     
    619619            DEALLOCATE( s_bkg    ) 
    620620         ENDIF 
    621          !   
     621         ! 
    622622      ENDIF 
    623623      ! Perhaps the following call should be in step 
     
    630630      !!---------------------------------------------------------------------- 
    631631      !!                    ***  ROUTINE dyn_asm_inc  *** 
    632       !!           
     632      !! 
    633633      !! ** Purpose : Apply the dynamics (u and v) assimilation increments. 
    634634      !! 
    635635      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
    636636      !! 
    637       !! ** Action  :  
     637      !! ** Action  : 
    638638      !!---------------------------------------------------------------------- 
    639639      INTEGER                             , INTENT( in )  ::  kt             ! ocean time-step index 
     
    656656            ! 
    657657            IF(lwp) THEN 
    658                WRITE(numout,*)  
     658               WRITE(numout,*) 
    659659               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    660660               WRITE(numout,*) '~~~~~~~~~~~~' 
     
    676676      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization 
    677677         !                          !----------------------------------------- 
    678          !          
     678         ! 
    679679         IF ( kt == nitdin_r ) THEN 
    680680            ! 
     
    683683            ! Initialize the now fields with the background + increment 
    684684            puu(:,:,:,Kmm) = u_bkg(:,:,:) + u_bkginc(:,:,:) 
    685             pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:)   
     685            pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:) 
    686686            ! 
    687687            puu(:,:,:,Kbb) = puu(:,:,:,Kmm)         ! Update before fields 
     
    702702      !!---------------------------------------------------------------------- 
    703703      !!                    ***  ROUTINE ssh_asm_inc  *** 
    704       !!           
     704      !! 
    705705      !! ** Purpose : Apply the sea surface height assimilation increment. 
    706706      !! 
    707707      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
    708708      !! 
    709       !! ** Action  :  
     709      !! ** Action  : 
    710710      !!---------------------------------------------------------------------- 
    711711      INTEGER, INTENT(IN) :: kt         ! Current time step 
     
    727727            ! 
    728728            IF(lwp) THEN 
    729                WRITE(numout,*)  
     729               WRITE(numout,*) 
    730730               WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 
    731731                  &  kt,' with IAU weight = ', wgtiau(it) 
     
    779779      !!                  ***  ROUTINE ssh_asm_div  *** 
    780780      !! 
    781       !! ** Purpose :   ssh increment with z* is incorporated via a correction of the local divergence           
     781      !! ** Purpose :   ssh increment with z* is incorporated via a correction of the local divergence 
    782782      !!                across all the water column 
    783783      !! 
     
    795795      REAL(wp), DIMENSION(:,:)  , POINTER       ::   ztim     ! local array 
    796796      !!---------------------------------------------------------------------- 
    797       !  
     797      ! 
    798798#if defined key_asminc 
    799799      CALL ssh_asm_inc( kt, Kbb, Kmm ) !==   (calculate increments) 
    800800      ! 
    801       IF( ln_linssh ) THEN  
     801      IF( ln_linssh ) THEN 
    802802         phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1) 
    803       ELSE  
     803      ELSE 
    804804         ALLOCATE( ztim(jpi,jpj) ) 
    805805         ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 
    806          DO jk = 1, jpkm1                                  
    807             phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk)  
     806         DO jk = 1, jpkm1 
     807            phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 
    808808         END DO 
    809809         ! 
     
    818818      !!---------------------------------------------------------------------- 
    819819      !!                    ***  ROUTINE seaice_asm_inc  *** 
    820       !!           
     820      !! 
    821821      !! ** Purpose : Apply the sea ice assimilation increment. 
    822822      !! 
    823823      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
    824824      !! 
    825       !! ** Action  :  
     825      !! ** Action  : 
    826826      !! 
    827827      !!---------------------------------------------------------------------- 
     
    844844            ! 
    845845            it = kt - nit000 + 1 
    846             zincwgt = wgtiau(it)      ! IAU weight for the current time step  
     846            zincwgt = wgtiau(it)      ! IAU weight for the current time step 
    847847            ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 
    848848            ! 
    849849            IF(lwp) THEN 
    850                WRITE(numout,*)  
     850               WRITE(numout,*) 
    851851               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    852852               WRITE(numout,*) '~~~~~~~~~~~~' 
     
    866866            ! 
    867867            ! Nudge sea ice depth to bring it up to a required minimum depth 
    868             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
    869                zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt     
     868            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 
     869               zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 
    870870            ELSEWHERE 
    871871               zhicifinc(:,:) = 0.0_wp 
     
    907907            zofrld (:,:) = 1._wp - at_i(:,:) 
    908908            zohicif(:,:) = hm_i(:,:) 
    909             !  
     909            ! 
    910910            ! Initialize the now fields the background + increment 
    911911            at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
    912             at_i_b(:,:) = at_i(:,:)  
     912            at_i_b(:,:) = at_i(:,:) 
    913913            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
    914914            ! 
     
    916916            ! 
    917917            ! Nudge sea ice depth to bring it up to a required minimum depth 
    918             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
     918            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 
    919919               zhicifinc(:,:) = zhicifmin - hm_i(:,:) 
    920920            ELSEWHERE 
     
    946946!#if defined defined key_si3 || defined key_cice 
    947947! 
    948 !            IF (ln_seaicebal ) THEN        
     948!            IF (ln_seaicebal ) THEN 
    949949!             !! balancing salinity increments 
    950950!             !! simple case from limflx.F90 (doesn't include a mass flux) 
     
    958958! 
    959959!             DO jj = 1, jpj 
    960 !               DO ji = 1, jpi  
     960!               DO ji = 1, jpi 
    961961!           ! calculate change in ice and snow mass per unit area 
    962962!           ! positive values imply adding salt to the ocean (results from ice formation) 
     
    969969! 
    970970!           ! prevent small mld 
    971 !           ! less than 10m can cause salinity instability  
     971!           ! less than 10m can cause salinity instability 
    972972!                 IF (mld < 10) mld=10 
    973973! 
    974 !           ! set to bottom of a level  
     974!           ! set to bottom of a level 
    975975!                 DO jk = jpk-1, 2, -1 
    976 !                   IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN  
     976!                   IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN 
    977977!                     mld=gdepw(ji,jj,jk+1) 
    978978!                     jkmax=jk 
     
    981981! 
    982982!            ! avoid applying salinity balancing in shallow water or on land 
    983 !            !  
     983!            ! 
    984984! 
    985985!            ! dsal_ocn (psu kg m^-2) / (kg m^-3 * m) 
     
    992992! 
    993993!           ! put increments in for levels in the mixed layer 
    994 !           ! but prevent salinity below a threshold value  
    995 ! 
    996 !                   DO jk = 1, jkmax               
    997 ! 
    998 !                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN  
     994!           ! but prevent salinity below a threshold value 
     995! 
     996!                   DO jk = 1, jkmax 
     997! 
     998!                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN 
    999999!                           sb(ji,jj,jk) = sb(ji,jj,jk) + dsal_ocn 
    10001000!                           sn(ji,jj,jk) = sn(ji,jj,jk) + dsal_ocn 
     
    10071007!      ! 
    10081008!      !! Adjust fsalt. A +ve fsalt means adding salt to ocean 
    1009 !      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt   
    1010 !      !!                
    1011 !      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d)  
     1009!      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt 
     1010!      !! 
     1011!      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d) 
    10121012!      !!                                                     ! E-P (kg m-2 s-2) 
    10131013!      !            emp(ji,jj) = emp(ji,jj) + zpmess          ! E-P (kg m-2 s-2) 
     
    10221022      ! 
    10231023   END SUBROUTINE seaice_asm_inc 
    1024     
     1024 
    10251025   !!====================================================================== 
    10261026END MODULE asminc 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydta.F90

    r12616 r12680  
    251251               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    252252               DO ik = 1, jpkm1 
    253                   dta_alias%u2d(ib) =   & 
    254                      & dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
     253                  dta_alias%u2d(ib) = dta_alias%u2d(ib)   & 
     254                     &             + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
    255255               END DO 
    256256               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) 
     
    265265               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    266266               DO ik = 1, jpkm1 
    267                   dta_alias%v2d(ib) =   & 
    268                      & dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
     267                  dta_alias%v2d(ib) = dta_alias%v2d(ib)   & 
     268                     &             + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
    269269               END DO 
    270270               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydyn.F90

    r12625 r12680  
    3737   !! Software governed by the CeCILL license (see ./LICENSE) 
    3838   !!---------------------------------------------------------------------- 
    39  
    4039CONTAINS 
    4140 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/C1D/step_c1d.F90

    r12377 r12680  
    8383      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )  ! after vertical scale factors  
    8484 
    85       IF(.NOT.ln_linssh )   CALL wzv           ( kstp, Nbb, Nnn, ww,  Naa )  ! now cross-level velocity  
     85      IF(.NOT.ln_linssh )   CALL wzv           ( kstp, Nbb, Nnn, Naa, ww )  ! now cross-level velocity  
    8686      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    8787      ! diagnostics and outputs        
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsini.F90

    r12625 r12680  
    3535   !! Software governed by the CeCILL license (see ./LICENSE) 
    3636   !!---------------------------------------------------------------------- 
    37  
    3837CONTAINS 
    3938    
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaar5.F90

    r12622 r12680  
    7878      ! 
    7979      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe, z2d                   ! 2D workspace  
    81       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop, ztpot, ze3t  ! 3D workspace 
     80      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z2d, zpe                   ! 2D workspace  
     81      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: z3d, zrhd , zrhop, ztpot   ! 3D workspace 
    8282      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8383 
     
    104104         END DO 
    105105         DO jk = 1, jpk 
    106             ze3t(:,:,jk) =  e3t(:,:,jk,Kmm) 
     106            z3d(:,:,jk) =  rau0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    107107         END DO  
    108108         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 
    109          CALL iom_put( 'masscello' , rau0 * ze3t(:,:,:) * tmask(:,:,:) )  ! ocean mass 
     109         CALL iom_put( 'masscello' , z3d (:,:,:) )   ! ocean mass 
    110110      ENDIF  
    111111      ! 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diadct.F90

    r12625 r12680  
    1111   !!            3.4  ! 09/2011 (C Bricaud) 
    1212   !!---------------------------------------------------------------------- 
    13    !! does not work with agrif 
    14 #if ! defined key_agrif 
     13#if ! defined key_agrif        
     14   !!                        ==>>  CAUTION: does not work with agrif 
    1515   !!---------------------------------------------------------------------- 
    1616   !!   dia_dct      :  Compute the transport through a sec. 
     
    6666   TYPE SECTION 
    6767      CHARACTER(len=60)                            :: name              ! name of the sec 
    68       LOGICAL                                      :: llstrpond         ! true if you want the computation of salt and 
    69                                                                        ! heat transports 
     68      LOGICAL                                      :: llstrpond         ! true if you want the computation of salt and heat transports 
    7069      LOGICAL                                      :: ll_ice_section    ! ice surface and ice volume computation 
    7170      LOGICAL                                      :: ll_date_line      ! = T if the section crosses the date-line 
     
    7473      INTEGER, DIMENSION(nb_point_max)             :: direction         ! vector direction of the point in the section 
    7574      CHARACTER(len=40),DIMENSION(nb_class_max)    :: classname         ! characteristics of the class 
    76       REAL(wp), DIMENSION(nb_class_max)            :: zsigi           ,&! in-situ   density classes    (99 if you don't want) 
    77                                                       zsigp           ,&! potential density classes    (99 if you don't want) 
    78                                                       zsal            ,&! salinity classes   (99 if you don't want) 
    79                                                       ztem            ,&! temperature classes(99 if you don't want) 
    80                                                       zlay              ! level classes      (99 if you don't want) 
     75      REAL(wp), DIMENSION(nb_class_max)            :: zsigi             ! in-situ   density classes    (99 if you don't want) 
     76      REAL(wp), DIMENSION(nb_class_max)            :: zsigp             ! potential density classes    (99 if you don't want) 
     77      REAL(wp), DIMENSION(nb_class_max)            :: zsal              ! salinity classes   (99 if you don't want) 
     78      REAL(wp), DIMENSION(nb_class_max)            :: ztem              ! temperature classes(99 if you don't want) 
     79      REAL(wp), DIMENSION(nb_class_max)            :: zlay              ! level classes      (99 if you don't want) 
    8180      REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport     ! transport output 
    8281      REAL(wp)                                         :: slopeSection  ! slope of the section 
     
    8988   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d  
    9089   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d   
     90 
    9191 
    9292   !! * Substitutions 
     
    11221122  !!    |               |                  |       interpolation between ptab(I,J,K) and ptab(I,J,K+1) 
    11231123  !!    |               |                  |       zbis =  
    1124   !!    |               |                  |      [ e3w_n(I+1,J,K)*ptab(I,J,K) + ( e3w_n(I,J,K) - e3w_n(I+1,J,K) ) * ptab(I,J,K-1) ] 
    1125   !!    |               |                  |      /[ e3w_n(I+1,J,K) + e3w_n(I,J,K) - e3w_n(I+1,J,K) ]  
     1124  !!    |               |                  |      [ e3w_n(I+1,J,K,NOW)*ptab(I,J,K) + ( e3w_n(I,J,K,NOW) - e3w_n(I+1,J,K,NOW) ) * ptab(I,J,K-1) ] 
     1125  !!    |               |                  |     /[ e3w_n(I+1,J,K,NOW)             +   e3w_n(I,J,K,NOW) - e3w_n(I+1,J,K,NOW) ]  
    11261126  !!    |               |                  |  
    11271127  !!    |               |                  |    2. Horizontal interpolation: compute value at U/V point 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diahsb.F90

    r12625 r12680  
    5757   !! Software governed by the CeCILL license (see ./LICENSE) 
    5858   !!---------------------------------------------------------------------- 
    59  
    6059CONTAINS 
    6160 
     
    159158      ! 
    160159      DO jk = 1, jpkm1           ! volume variation (calculated with scale factors) 
    161          zwrk(:,:,jk) =   surf(:,:) * e3t(:,:,jk,Kmm)*tmask(:,:,jk)   & 
     160         zwrk(:,:,jk) =   surf    (:,:) * e3t    (:,:,jk,Kmm)*tmask    (:,:,jk)   & 
    162161            &           - surf_ini(:,:) * e3t_ini(:,:,jk    )*tmask_ini(:,:,jk) 
    163162      END DO 
    164163      zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) )     ! glob_sum_full needed as tmask and tmask_ini could be different 
    165164      DO jk = 1, jpkm1           ! heat content variation 
    166          zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm)   & 
    167             &           - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) 
     165         zwrk(:,:,jk) = ( surf    (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm)   & 
     166            &           - surf_ini(:,:) *         hc_loc_ini(:,:,jk) ) 
    168167      END DO 
    169168      zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 
    170169      DO jk = 1, jpkm1           ! salt content variation 
    171          zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm)   & 
    172             &           - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) 
     170         zwrk(:,:,jk) = ( surf    (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm)   & 
     171            &           - surf_ini(:,:) *         sc_loc_ini(:,:,jk) ) 
    173172      END DO 
    174173      zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diamlr.F90

    r12482 r12680  
    44   !! Management of the IOM context for multiple-linear-regression analysis 
    55   !!====================================================================== 
    6    !! History :       !  2019  (S. Mueller) 
     6   !! History :  4.0  !  2019  (S. Mueller)   Original code 
    77   !!---------------------------------------------------------------------- 
    88 
    99   USE par_oce        , ONLY :   wp, jpi, jpj 
    1010   USE phycst         , ONLY :   rpi 
     11   USE dom_oce        , ONLY :   adatrj 
     12   USE tide_mod 
     13   ! 
    1114   USE in_out_manager , ONLY :   lwp, numout, ln_timing 
    1215   USE iom            , ONLY :   iom_put, iom_use, iom_update_file_name 
    13    USE dom_oce        , ONLY :   adatrj 
    1416   USE timing         , ONLY :   timing_start, timing_stop 
    1517#if defined key_iomput 
    1618   USE xios 
    1719#endif 
    18    USE tide_mod 
    1920 
    2021   IMPLICIT NONE 
    2122   PRIVATE 
    2223 
    23    LOGICAL, PUBLIC ::   lk_diamlr = .FALSE. 
     24   LOGICAL, PUBLIC ::   lk_diamlr = .FALSE.   !:         ===>>>   NOT a DOCTOR norm name :  use l_diamlr 
     25   !                                                              lk_  is used only for logical controlled by a CPP key 
    2426 
    2527   PUBLIC ::   dia_mlr_init, dia_mlr_iom_init, dia_mlr 
     
    4244      !! 
    4345      !!---------------------------------------------------------------------- 
    44  
     46      ! 
    4547      lk_diamlr = .TRUE. 
    46  
     48      ! 
    4749      IF(lwp) THEN 
    4850         WRITE(numout, *) 
     
    5052         WRITE(numout, *) '~~~~~~~~~~~~   multiple-linear-regression analysis' 
    5153      END IF 
    52  
     54      ! 
    5355   END SUBROUTINE dia_mlr_init 
     56 
    5457 
    5558   SUBROUTINE dia_mlr_iom_init 
     
    396399   END SUBROUTINE dia_mlr_iom_init 
    397400 
     401 
    398402   SUBROUTINE dia_mlr 
    399403      !!---------------------------------------------------------------------- 
     
    403407      !! 
    404408      !!---------------------------------------------------------------------- 
    405  
    406409      REAL(wp), DIMENSION(jpi,jpj) ::   zadatrj2d 
     410      !!---------------------------------------------------------------------- 
    407411 
    408412      IF( ln_timing )   CALL timing_start('dia_mlr') 
     
    411415      ! (value of adatrj converted to time in units of seconds) 
    412416      ! 
    413       ! A 2-dimensional field of constant value is sent, and subsequently used 
    414       ! directly or transformed to a scalar or a constant 3-dimensional field as 
    415       ! required. 
     417      ! A 2-dimensional field of constant value is sent, and subsequently used directly  
     418      ! or transformed to a scalar or a constant 3-dimensional field as required. 
    416419      zadatrj2d(:,:) = adatrj*86400.0_wp 
    417420      IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d) 
    418  
     421      ! 
    419422      IF( ln_timing )   CALL timing_stop('dia_mlr') 
    420  
     423      ! 
    421424   END SUBROUTINE dia_mlr 
    422425 
     426   !!====================================================================== 
    423427END MODULE diamlr 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaptr.F90

    r12622 r12680  
    6060 
    6161   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini) 
     62    
    6263   !! * Substitutions 
    6364#  include "do_loop_substitute.h90" 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diawri.F90

    r12622 r12680  
    121121      REAL(wp)::   zztmp2, zztmpy   !   -      - 
    122122      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace 
    123       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d, ze3t, ze3u, ze3v, ze3w   ! 3D workspace 
     123      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace 
    124124      !!---------------------------------------------------------------------- 
    125125      !  
     
    137137      CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
    138138      ! 
    139       DO jk = 1, jpk 
    140          ze3t(:,:,jk) =  e3t(:,:,jk,Kmm) 
    141          ze3u(:,:,jk) =  e3u(:,:,jk,Kmm) 
    142          ze3v(:,:,jk) =  e3v(:,:,jk,Kmm) 
    143          ze3w(:,:,jk) =  e3w(:,:,jk,Kmm) 
    144       END DO  
    145       ! 
    146       CALL iom_put( "e3t" , ze3t(:,:,:) ) 
    147       CALL iom_put( "e3u" , ze3u(:,:,:) ) 
    148       CALL iom_put( "e3v" , ze3v(:,:,:) ) 
    149       CALL iom_put( "e3w" , ze3w(:,:,:) ) 
    150       IF( iom_use("e3tdef") )   & 
    151          CALL iom_put( "e3tdef"  , ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) !!st r3t 
    152  
    153       IF( ll_wd ) THEN 
    154          CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
     139      IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN  ! time-varying e3t 
     140         DO jk = 1, jpk 
     141            z3d(:,:,jk) =  e3t(:,:,jk,Kmm) 
     142         END DO 
     143         CALL iom_put( "e3t"     ,     z3d(:,:,:) ) 
     144         CALL iom_put( "e3tdef"  , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) !!st r3t 
     145      ENDIF  
     146      IF ( iom_use("e3u") ) THEN                         ! time-varying e3u 
     147         DO jk = 1, jpk 
     148            z3d(:,:,jk) =  e3u(:,:,jk,Kmm) 
     149         END DO  
     150         CALL iom_put( "e3u" , z3d(:,:,:) ) 
     151      ENDIF 
     152      IF ( iom_use("e3v") ) THEN                         ! time-varying e3v 
     153         DO jk = 1, jpk 
     154            z3d(:,:,jk) =  e3v(:,:,jk,Kmm) 
     155         END DO  
     156         CALL iom_put( "e3v" , z3d(:,:,:) ) 
     157      ENDIF 
     158      IF ( iom_use("e3w") ) THEN                         ! time-varying e3w 
     159         DO jk = 1, jpk 
     160            z3d(:,:,jk) =  e3w(:,:,jk,Kmm) 
     161         END DO  
     162         CALL iom_put( "e3w" , z3d(:,:,:) ) 
     163      ENDIF 
     164 
     165      IF( ll_wd ) THEN                                   ! sea surface height (brought back to the reference used for wetting and drying) 
     166         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 
    155167      ELSE 
    156168         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height 
     
    216228 
    217229      IF( ln_zad_Aimp ) ww = ww + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 
    218       ! 
    219230      CALL iom_put( "woce", ww )                   ! vertical velocity 
     231 
    220232      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    221233         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
     
    777789         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T  )   ! heat content 
    778790         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T  )   ! salt content 
    779          CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface heat content 
    780          CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity content 
     791         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content 
     792         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content 
    781793      ELSE 
    782794         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T  )   ! temperature 
     
    930942      !!---------------------------------------------------------------------- 
    931943      !  
    932       IF(lwp) WRITE(numout,*) 
    933       IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
    934       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    935       IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    936  
     944      IF(lwp) THEN 
     945         WRITE(numout,*) 
     946         WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
     947         WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
     948         WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
     949      ENDIF  
     950      ! 
    937951      DO jk = 1, jpk 
    938952         ze3t(:,:,jk) =  e3t(:,:,jk,Kmm) 
    939953      END DO 
    940  
     954      ! 
    941955#if defined key_si3 
    942956     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dom_oce.F90

    r12482 r12680  
    22   !!====================================================================== 
    33   !!                       ***  MODULE dom_oce  *** 
    4    !! 
    54   !! ** Purpose :   Define in memory all the ocean space domain variables 
    65   !!====================================================================== 
     
    7574   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity 
    7675 
    77    !                                 ! domain MPP decomposition parameters 
     76   !                             !: domain MPP decomposition parameters 
    7877   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom 
    7978   INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j 
     
    138137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0   !: vw-vert. scale factor [m] 
    139138   !                                                        !  time-dependent scale factors 
     139#if ! defined key_qco 
    140140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
    141141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m] 
     142#endif 
    142143   !                                                        !  time-dependent ratio ssh / h_0 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   r3t, r3u, r3v                   !: [-] 
    144    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r3f                             !: [-] 
    145    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r3t_f, r3u_f, r3v_f             !: [-] 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   r3t, r3u, r3v                   !: time-dependent    ratio at t-, u- and v-point [-] 
     145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r3f                             !: mid-time-level    ratio at f-point            [-] 
     146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r3t_f, r3u_f, r3v_f             !: now time-filtered ratio at t-, u- and v-point [-] 
    146147 
    147148   !                                                        !  reference depths of cells 
    148    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0  !: t- depth              [m] 
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0  !: w- depth              [m] 
    150    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdept_0  !: t- depth              [m] 
     150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdepw_0  !: w- depth              [m] 
     151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    151152   !                                                        !  time-dependent depths of cells 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw 
    153    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w 
    154  
    155    !                                                      !  reference heights of water column 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0  !: t-depth              [m] 
    157    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  !: u-depth              [m] 
    158    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  !: v-depth              [m] 
    159    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hf_0  !: f-depth              [m] 
    160    !                                                      !  reciprocal reference heights of water column 
    161    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_ht_0, r1_hu_0, r1_hv_0, r1_hf_0   !: t-depth   [1/m] 
    162                                                           ! time-dependent heights of water column 
    163    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m] 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hu, hv, r1_hu, r1_hv   !: height of water column [m] and reciprocal [1/m] 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   gdept, gdepw 
     154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gde3w 
     155 
     156   !                                                        !  reference heights of ocean water column and its inverse 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht_0, r1_ht_0   !: t-depth        [m] and [1/m] 
     158   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hu_0, r1_hu_0   !: u-depth        [m] and [1/m] 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hv_0, r1_hv_0   !: v-depth        [m] and [1/m] 
     160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hf_0, r1_hf_0   !: f-depth        [m] and [1/m] 
     161   !                                                        ! time-dependent heights of ocean water column 
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht          !: t-points           [m] 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hu, r1_hu   !: u-depth            [m] and [1/m] 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hv, r1_hv   !: v-depth            [m] and [1/m] 
    165165 
    166166   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
     
    178178   !! --------------------------------------------------------------------- 
    179179!!gm Proposition of new name for top/bottom vertical indices 
    180 !   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top first wet T-, U-, V-, F-level (ISF) 
    181 !   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last wet T-, U- and V-level 
     180!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top    first wet T-, U-, and V-level (ISF) 
     181!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last  wet T-, U-, and V-level 
    182182!!gm 
    183183   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level 
     
    187187   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level           (ISF) 
    188188 
    189    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts 
    190    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    191    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
     189   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   ssmask, ssumask, ssvmask, ssfmask   !: surface mask at T-,U-, V- and F-pts 
     190   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask            !: land/ocean mask at T-, U-, V- and F-pts 
     191   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask                 !: land/ocean mask at WT-, WU- and WV-pts 
    192192 
    193193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
     
    211211   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    212212   !                                   !: (cumulative duration of previous runs that may have used different time-step size) 
    213    INTEGER , PUBLIC, DIMENSION(  0: 2) ::   nyear_len     !: length in days of the previous/current/next year 
    214    INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_len    !: length in days of the months of the current year 
    215    INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_beg    !: second since Jan 1st 0h of the current year and the half of the months 
    216    INTEGER , PUBLIC                  ::   nsec1jan000     !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 
    217    INTEGER , PUBLIC                  ::   nsec000_1jan000   !: second since Jan 1st 0h of nit000 year and nit000 
    218    INTEGER , PUBLIC                  ::   nsecend_1jan000   !: second since Jan 1st 0h of nit000 year and nitend 
     213   INTEGER , PUBLIC, DIMENSION(  0: 2) ::   nyear_len         !: length in days of the previous/current/next year 
     214   INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_len        !: length in days of the months of the current year 
     215   INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_beg        !: second since Jan 1st 0h of the current year and the half of the months 
     216   INTEGER , PUBLIC                    ::   nsec1jan000       !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 
     217   INTEGER , PUBLIC                    ::   nsec000_1jan000   !: second since Jan 1st 0h of nit000 year and nit000 
     218   INTEGER , PUBLIC                    ::   nsecend_1jan000   !: second since Jan 1st 0h of nit000 year and nitend 
    219219 
    220220   !!---------------------------------------------------------------------- 
     
    249249   INTEGER FUNCTION dom_oce_alloc() 
    250250      !!---------------------------------------------------------------------- 
    251       INTEGER, DIMENSION(12) :: ierr 
     251      INTEGER                ::   ii 
     252      INTEGER, DIMENSION(30) :: ierr 
    252253      !!---------------------------------------------------------------------- 
    253       ierr(:) = 0 
     254      ii = 0   ;   ierr(:) = 0 
    254255      ! 
    255       ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) ) 
    256          ! 
    257       ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
    258          &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
    259          ! 
     256      ii = ii+1 
     257      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(ii) ) 
     258         ! 
     259      ii = ii+1 
     260      ALLOCATE( mi0 (jpiglo) , mi1 (jpiglo),  mj0(jpjglo) , mj1 (jpjglo) ,     & 
     261         &      tpol(jpiglo) , fpol(jpiglo)                              , STAT=ierr(ii) ) 
     262         ! 
     263      ii = ii+1 
    260264      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 
    261265         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     & 
     
    268272         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
    269273         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
    270          &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) ) 
    271          ! 
     274         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(ii) ) 
     275         ! 
     276      ii = ii+1 
    272277      ALLOCATE( gdept_0(jpi,jpj,jpk)     , gdepw_0(jpi,jpj,jpk)     , gde3w_0(jpi,jpj,jpk) ,      & 
    273          &      gdept  (jpi,jpj,jpk,jpt) , gdepw  (jpi,jpj,jpk,jpt) , gde3w  (jpi,jpj,jpk) , STAT=ierr(4) ) 
    274          ! 
    275       ALLOCATE( e3t_0(jpi,jpj,jpk)     , e3u_0(jpi,jpj,jpk)     , e3v_0(jpi,jpj,jpk)     , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk)     ,   & 
    276          &      e3t  (jpi,jpj,jpk,jpt) , e3u  (jpi,jpj,jpk,jpt) , e3v  (jpi,jpj,jpk,jpt) , e3f  (jpi,jpj,jpk) , e3w  (jpi,jpj,jpk,jpt) ,   & 
    277          &      e3uw_0(jpi,jpj,jpk)     , e3vw_0(jpi,jpj,jpk)     ,         & 
    278          &      e3uw  (jpi,jpj,jpk,jpt) , e3vw  (jpi,jpj,jpk,jpt) ,         & 
    279          &      r3t  (jpi,jpj,jpt)     , r3u  (jpi,jpj,jpt)     , r3v  (jpi,jpj,jpt)     , r3f  (jpi,jpj) ,  & 
    280          &      r3t_f(jpi,jpj)         , r3u_f(jpi,jpj)         , r3v_f(jpi,jpj)                          ,  STAT=ierr(5) ) 
    281          ! 
    282       ALLOCATE( ht_0(jpi,jpj) ,    hu_0(jpi,jpj)    ,    hv_0(jpi,jpj)     , hf_0(jpi,jpj)     ,   & 
    283          &      ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt) ,                       & 
    284          &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt) ,                       & 
    285          &   r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) ,    r1_hv_0(jpi,jpj),   r1_hf_0(jpi,jpj)     ,   STAT=ierr(6)  ) 
    286          ! 
    287       ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(7)  )  
    288          ! 
    289       ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(8) ) 
    290          ! 
    291       ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
    292          &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) ,    & 
    293          &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    294          ! 
    295       ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(10) ) 
    296          ! 
     278         &      gdept  (jpi,jpj,jpk,jpt) , gdepw  (jpi,jpj,jpk,jpt) , gde3w  (jpi,jpj,jpk) , STAT=ierr(ii) ) 
     279         ! 
     280      ii = ii+1 
     281      ALLOCATE(  e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0 (jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) ,      & 
     282         &       e3w_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk)                      ,  STAT=ierr(ii) ) 
     283         ! 
     284#if ! defined key_qco 
     285      ii = ii+1 
     286      ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) ,      & 
     287         &      e3w(jpi,jpj,jpk,jpt) , e3uw(jpi,jpj,jpk,jpt) , e3vw(jpi,jpj,jpk,jpt)                    ,  STAT=ierr(ii) ) 
     288#endif   
     289         ! 
     290      ii = ii+1 
     291      ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,  & 
     292         &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) )        
     293         ! 
     294      ii = ii+1 
     295      ALLOCATE( ht_0(jpi,jpj) ,    hu_0(jpi,jpj)    ,    hv_0(jpi,jpj)     , hf_0(jpi,jpj) ,       & 
     296         &      ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
     297         &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,       & 
     298         &   r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) ,    r1_hv_0(jpi,jpj),   r1_hf_0(jpi,jpj) ,   STAT=ierr(ii)  ) 
     299         ! 
     300      ii = ii+1 
     301      ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii)  )  
     302         ! 
     303      ii = ii+1 
     304      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(ii) ) 
     305         ! 
     306      ii = ii+1 
     307      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                           & 
     308         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) ,     & 
     309         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) ,                    STAT=ierr(ii) ) 
     310         ! 
     311      ii = ii+1 
     312      ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(ii) ) 
     313         ! 
     314      ii = ii+1 
    297315      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
    298          &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(11) ) 
    299          ! 
    300       ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) ) 
     316         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
     317         ! 
     318      ii = ii+1 
     319      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
    301320      ! 
    302321      dom_oce_alloc = MAXVAL(ierr) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90

    r12482 r12680  
    3535   USE dommsk         ! domain: set the mask system 
    3636   USE domwri         ! domain: write the meshmask file 
     37#if ! defined key_qco 
    3738   USE domvvl         ! variable volume 
     39#else 
     40   USE domqe          ! variable volume 
     41#endif 
    3842   USE c1d            ! 1D configuration 
    3943   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine) 
     
    7781      CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables 
    7882      ! 
    79       INTEGER ::   ji, jj, jk, ik   ! dummy loop indices 
     83      INTEGER ::   ji, jj, jk, jt   ! dummy loop indices 
    8084      INTEGER ::   iconf = 0    ! local integers 
    8185      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
     
    111115         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)' 
    112116         CASE DEFAULT 
    113             CALL ctl_stop( 'jperio is out of range' ) 
     117            CALL ctl_stop( 'dom_init:   jperio is out of range' ) 
    114118         END SELECT 
    115119         WRITE(numout,*)     '      Ocean model configuration used:' 
     
    141145      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes 
    142146 
    143       CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry 
     147      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices) 
    144148 
    145149      CALL dom_msk( ik_top, ik_bot )    ! Masks 
     
    160164      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp -  ssvmask(:,:) ) 
    161165      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp -  ssfmask(:,:) ) 
     166 
    162167      ! 
    163168      !           !==  time varying part of coordinate system  ==! 
    164169      ! 
    165170      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all 
    166       ! 
    167          !       before        !          now          !       after         ! 
    168             gdept(:,:,:,Kbb) = gdept_0  ;   gdept(:,:,:,Kmm) = gdept_0   ;   gdept(:,:,:,Kaa) = gdept_0   ! depth of grid-points 
    169             gdepw(:,:,:,Kbb) = gdepw_0  ;   gdepw(:,:,:,Kmm) = gdepw_0   ;   gdepw(:,:,:,Kaa) = gdepw_0   ! 
    170                                             gde3w            = gde3w_0   !        ---          ! 
    171          ! 
    172               e3t(:,:,:,Kbb) =   e3t_0  ;     e3t(:,:,:,Kmm) =   e3t_0   ;   e3t(:,:,:,Kaa) =  e3t_0    ! scale factors 
    173               e3u(:,:,:,Kbb) =   e3u_0  ;     e3u(:,:,:,Kmm) =   e3u_0   ;   e3u(:,:,:,Kaa) =  e3u_0    ! 
    174               e3v(:,:,:,Kbb) =   e3v_0  ;     e3v(:,:,:,Kmm) =   e3v_0   ;   e3v(:,:,:,Kaa) =  e3v_0    ! 
    175                                      e3f =   e3f_0   !        ---          ! 
    176               e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   ! 
    177              e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   ! 
    178              e3vw(:,:,:,Kbb) =  e3vw_0  ;    e3vw(:,:,:,Kmm) =  e3vw_0   ;   e3vw(:,:,:,Kaa) =  e3vw_0   ! 
    179          ! 
    180 ! !!st new variable h1_hu_0 h1_hv_0 
    181 !          z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
    182 !          z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
    183          ! 
    184          !        before       !          now          !       after         ! 
    185                                       ht =    ht_0   !                     ! water column thickness 
    186                hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   ! 
    187                hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   ! 
    188             r1_hu(:,:,Kbb) = r1_hu_0  ;   r1_hu(:,:,Kmm) = r1_hu_0   ; r1_hu(:,:,Kaa) = r1_hu_0   ! inverse of water column thickness 
    189             r1_hv(:,:,Kbb) = r1_hv_0  ;   r1_hv(:,:,Kmm) = r1_hv_0   ; r1_hv(:,:,Kaa) = r1_hv_0   ! 
    190          ! 
     171         ! 
     172         DO jt = 1, jpt                         ! depth of t- and w-grid-points 
     173            gdept(:,:,:,jt) = gdept_0(:,:,:) 
     174            gdepw(:,:,:,jt) = gdepw_0(:,:,:) 
     175         END DO 
     176            gde3w(:,:,:)    = gde3w_0(:,:,:)    ! = gdept as the sum of e3t 
     177         ! 
     178#if defined key_qco 
     179         !  Quasi-Euerian coordinate : no initialisation of e3. scale factors 
     180#else 
     181         DO jt = 1, jpt                         ! vertical scale factors 
     182            e3t(:,:,:,jt) =  e3t_0(:,:,:) 
     183            e3u(:,:,:,jt) =  e3u_0(:,:,:) 
     184            e3v(:,:,:,jt) =  e3v_0(:,:,:) 
     185            e3w(:,:,:,jt) =  e3w_0(:,:,:) 
     186            e3uw(:,:,:,jt) = e3uw_0(:,:,:) 
     187            e3vw(:,:,:,jt) = e3vw_0(:,:,:) 
     188         END DO 
     189            e3f(:,:,:)    =  e3f_0(:,:,:) 
     190         ! 
     191#endif 
     192         ! 
     193         DO jt = 1, jpt                         ! water column thickness and its inverse 
     194            hu(:,:,jt)    =    hu_0(:,:) 
     195            hv(:,:,jt)    =    hv_0(:,:) 
     196            r1_hu(:,:,jt) = r1_hu_0(:,:) 
     197            r1_hv(:,:,jt) = r1_hv_0(:,:) 
     198         END DO 
     199            ht(:,:) =    ht_0(:,:) 
    191200         ! 
    192201      ELSE                       != time varying : initialize before/now/after variables 
    193202         ! 
    194          IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
     203#if defined key_qco 
     204         IF( .NOT.l_offline )   CALL dom_qe_init( Kbb, Kmm, Kaa ) 
     205#else 
     206         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
     207#endif 
    195208         ! 
    196209      ENDIF 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dommsk.F90

    r12482 r12680  
    143143      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...) 
    144144      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
    145  
     145       
    146146     ! Mask corrections for bdy (read in mppini2) 
    147147      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90

    r12679 r12680  
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1010   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
    11    !!            4.x  ! 2020-02  (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate 
     11   !!            4.x  !  2020-02  (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate 
    1212   !!---------------------------------------------------------------------- 
    1313 
    1414   !!---------------------------------------------------------------------- 
    15    !!   dom_qe_init     : define initial vertical scale factors, depths and column thickness 
    16    !!   dom_qe_sf_nxt   : Compute next vertical scale factors 
    17    !!   dom_qe_sf_update   : Swap vertical scale factors and update the vertical grid 
     15   !!   dom_qe_init   : define initial vertical scale factors, depths and column thickness 
     16   !!   dom_qe_sf_nxt : Compute next vertical scale factors 
     17   !!   dom_qe_sf_update: Swap vertical scale factors and update the vertical grid 
    1818   !!   dom_qe_interpol : Interpolate vertical scale factors from one grid point to another 
    19    !!   dom_qe_r3c      : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 
    20    !!   dom_qe_rst      : read/write restart file 
    21    !!   dom_qe_ctl      : Check the vvl options 
     19   !!   dom_qe_r3c    : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 
     20   !!       qe_rst_read : read/write restart file 
     21   !!   dom_qe_ctl    : Check the vvl options 
    2222   !!---------------------------------------------------------------------- 
    23    USE oce             ! ocean dynamics and tracers 
    24    USE phycst          ! physical constant 
    25    USE dom_oce         ! ocean space and time domain 
     23   USE oce            ! ocean dynamics and tracers 
     24   USE phycst         ! physical constant 
     25   USE dom_oce        ! ocean space and time domain 
    2626   USE dynadv  , ONLY : ln_dynadv_vec 
    27    USE isf_oce         ! iceshelf cavities 
    28    USE sbc_oce         ! ocean surface boundary condition 
    29    USE wet_dry         ! wetting and drying 
    30    USE usrdef_istate   ! user defined initial state (wad only) 
    31    USE restart         ! ocean restart 
     27   USE isf_oce        ! iceshelf cavities 
     28   USE sbc_oce        ! ocean surface boundary condition 
     29   USE wet_dry        ! wetting and drying 
     30   USE usrdef_istate  ! user defined initial state (wad only) 
     31   USE restart        ! ocean restart 
    3232   ! 
    33    USE in_out_manager  ! I/O manager 
    34    USE iom             ! I/O manager library 
    35    USE lib_mpp         ! distributed memory computing library 
    36    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    37    USE timing          ! Timing 
     33   USE in_out_manager ! I/O manager 
     34   USE iom            ! I/O manager library 
     35   USE lib_mpp        ! distributed memory computing library 
     36   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     37   USE timing         ! Timing 
    3838 
    3939   IMPLICIT NONE 
     
    4242   PUBLIC  dom_qe_init       ! called by domain.F90 
    4343   PUBLIC  dom_qe_zgr        ! called by isfcpl.F90 
    44    PUBLIC  dom_qe_sf_nxt     ! called by steplf.F90 
    45    PUBLIC  dom_qe_sf_update  ! called by steplf.F90 
     44!!st   PUBLIC  dom_qe_sf_nxt     ! called by steplf.F90 
     45!!st   PUBLIC  dom_qe_sf_update  ! called by steplf.F90 
    4646   PUBLIC  dom_h_nxt         ! called by steplf.F90 
     47   PUBLIC  dom_h_update      ! called by steplf.F90 
    4748   PUBLIC  dom_qe_r3c        ! called by steplf.F90 
    4849 
     
    102103      ! 
    103104      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    104       CALL dom_qe_rst( nit000, Kbb, Kmm, 'READ' ) 
    105       e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
     105      CALL qe_rst_read( nit000, Kbb, Kmm ) 
     106!!st      e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
    106107      ! 
    107108      CALL dom_qe_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
    108109      ! 
    109       IF(lwxios) THEN   ! define variables in restart file when writing with XIOS 
    110          CALL iom_set_rstw_var_active('e3t_b') 
    111          CALL iom_set_rstw_var_active('e3t_n') 
    112       ENDIF 
     110      ! IF(lwxios) THEN   ! define variables in restart file when writing with XIOS 
     111      !    CALL iom_set_rstw_var_active('e3t_b') 
     112      !    CALL iom_set_rstw_var_active('e3t_n') 
     113      ! ENDIF 
    113114      ! 
    114115   END SUBROUTINE dom_qe_init 
     
    147148      CALL dom_qe_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    148149      ! 
    149       DO jk = 1, jpkm1                    ! Horizontal interpolation of e3t 
    150          e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) )   ! Kbb time level 
    151          e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 
    152          e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 
    153          e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) )   ! Kmm time level 
    154          e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 
    155          e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 
    156          e3f(:,:,jk)     = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:)     * fmask(:,:,jk) ) 
    157       END DO 
    158       ! 
    159       DO jk = 1, jpk                      ! Vertical interpolation of e3t,u,v 
    160          !                                   ! The ratio does not have to be masked at w-level 
    161          e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
    162          e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
    163          e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
    164          e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
    165          e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
    166          e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
    167       END DO 
    168       ! 
    169       ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 
    170       e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 
    171       e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 
    172       e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 
     150! !!st 
     151!       DO jk = 1, jpkm1                    ! Horizontal interpolation of e3t 
     152!          e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) )   ! Kbb time level 
     153!          e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 
     154!          e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 
     155!          e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) )   ! Kmm time level 
     156!          e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 
     157!          e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 
     158!          e3f(:,:,jk)     = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:)     * fmask(:,:,jk) ) 
     159!       END DO 
     160!       ! 
     161!       DO jk = 1, jpk                      ! Vertical interpolation of e3t,u,v 
     162!          !                                   ! The ratio does not have to be masked at w-level 
     163!          e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
     164!          e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
     165!          e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
     166!          e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
     167!          e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
     168!          e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
     169!       END DO 
     170!       ! 
     171!       ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 
     172!       e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 
     173!       e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 
     174!       e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 
     175!!st end 
    173176      ! 
    174177      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
     
    221224   END SUBROUTINE dom_qe_zgr 
    222225 
    223  
    224    SUBROUTINE dom_qe_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
     226! !!st 
     227!    SUBROUTINE dom_qe_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
     228!       !!---------------------------------------------------------------------- 
     229!       !!                ***  ROUTINE dom_qe_sf_nxt  *** 
     230!       !! 
     231!       !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt, 
     232!       !!                 tranxt and dynspg routines 
     233!       !! 
     234!       !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness. 
     235!       !! 
     236!       !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
     237!       !!               - tilde_e3t_a: after increment of vertical scale factor 
     238!       !!                              in z_tilde case 
     239!       !!               - e3(t/u/v)_a 
     240!       !! 
     241!       !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling. 
     242!       !!---------------------------------------------------------------------- 
     243!       INTEGER, INTENT( in )           ::   kt             ! time step 
     244!       INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step 
     245!       INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
     246!       ! 
     247!       INTEGER                ::   ji, jj, jk            ! dummy loop indices 
     248!       INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers 
     249!       REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
     250!       LOGICAL                ::   ll_do_bclinic         ! local logical 
     251!       REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
     252!       !!---------------------------------------------------------------------- 
     253!       ! 
     254!       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
     255!       ! 
     256!       IF( ln_timing )   CALL timing_start('dom_qe_sf_nxt') 
     257!       ! 
     258!       IF( kt == nit000 ) THEN 
     259!          IF(lwp) WRITE(numout,*) 
     260!          IF(lwp) WRITE(numout,*) 'dom_qe_sf_nxt : compute after scale factors' 
     261!          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
     262!       ENDIF 
     263! 
     264! 
     265!       ! ******************************* ! 
     266!       ! After acale factors at t-points ! 
     267!       ! ******************************* ! 
     268!       !                                                ! --------------------------------------------- ! 
     269!       !                                                ! z_star coordinate and barotropic z-tilde part ! 
     270!       !                                                ! --------------------------------------------- ! 
     271!       ! 
     272!       ! 
     273!       ! *********************************** ! 
     274!       ! After scale factors at u- v- points ! 
     275!       ! *********************************** ! 
     276!       ! 
     277!       DO jk = 1, jpkm1 
     278!          e3t(:,:,jk,Kaa) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kaa) * tmask(:,:,jk) ) 
     279!          e3u(:,:,jk,Kaa) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kaa) * umask(:,:,jk) ) 
     280!          e3v(:,:,jk,Kaa) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kaa) * vmask(:,:,jk) ) 
     281!       END DO 
     282!       ! 
     283!       ! *********************************** ! 
     284!       ! After depths at u- v points         ! 
     285!       ! *********************************** ! 
     286!       hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
     287!       hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
     288!       !                                        ! Inverse of the local depth 
     289!       r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
     290!       r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
     291!       ! 
     292!       IF( ln_timing )   CALL timing_stop('dom_qe_sf_nxt') 
     293!       ! 
     294!    END SUBROUTINE dom_qe_sf_nxt 
     295!!st end 
     296 
     297   SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    225298      !!---------------------------------------------------------------------- 
    226299      !!                ***  ROUTINE dom_qe_sf_nxt  *** 
    227300      !! 
    228       !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt, 
     301      !! ** Purpose :  - compute the after water heigh used in tra_zdf, dynnxt, 
    229302      !!                 tranxt and dynspg routines 
    230303      !! 
    231       !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness. 
    232       !! 
    233       !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
    234       !!               - tilde_e3t_a: after increment of vertical scale factor 
    235       !!                              in z_tilde case 
    236       !!               - e3(t/u/v)_a 
    237       !! 
    238       !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling. 
     304      !! ** Method  :  - z_star case:  Proportionnaly to the water column thickness. 
     305      !! 
     306      !! ** Action  :  - h(u/v) update wrt ssh/h(u/v)_0 
     307      !! 
    239308      !!---------------------------------------------------------------------- 
    240309      INTEGER, INTENT( in )           ::   kt             ! time step 
     
    242311      INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
    243312      ! 
    244       INTEGER                ::   ji, jj, jk            ! dummy loop indices 
    245       INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers 
    246       REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
    247       LOGICAL                ::   ll_do_bclinic         ! local logical 
    248       REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    249313      !!---------------------------------------------------------------------- 
    250314      ! 
    251315      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    252316      ! 
    253       IF( ln_timing )   CALL timing_start('dom_qe_sf_nxt') 
     317      IF( ln_timing )   CALL timing_start('dom_h_nxt') 
    254318      ! 
    255319      IF( kt == nit000 ) THEN 
    256320         IF(lwp) WRITE(numout,*) 
    257          IF(lwp) WRITE(numout,*) 'dom_qe_sf_nxt : compute after scale factors' 
     321         IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 
    258322         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    259323      ENDIF 
    260  
    261  
    262       ! ******************************* ! 
    263       ! After acale factors at t-points ! 
    264       ! ******************************* ! 
    265       !                                                ! --------------------------------------------- ! 
    266       !                                                ! z_star coordinate and barotropic z-tilde part ! 
    267       !                                                ! --------------------------------------------- ! 
    268       ! 
    269       ! 
    270       ! *********************************** ! 
    271       ! After scale factors at u- v- points ! 
    272       ! *********************************** ! 
    273       ! 
    274       DO jk = 1, jpkm1 
    275          e3t(:,:,jk,Kaa) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kaa) * tmask(:,:,jk) ) 
    276          e3u(:,:,jk,Kaa) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kaa) * umask(:,:,jk) ) 
    277          e3v(:,:,jk,Kaa) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kaa) * vmask(:,:,jk) ) 
    278       END DO 
    279324      ! 
    280325      ! *********************************** ! 
     
    287332      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
    288333      ! 
    289       IF( ln_timing )   CALL timing_stop('dom_qe_sf_nxt') 
    290       ! 
    291    END SUBROUTINE dom_qe_sf_nxt 
    292  
    293  
    294    SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    295       !!---------------------------------------------------------------------- 
    296       !!                ***  ROUTINE dom_qe_sf_nxt  *** 
    297       !! 
    298       !! ** Purpose :  - compute the after water heigh used in tra_zdf, dynnxt, 
    299       !!                 tranxt and dynspg routines 
    300       !! 
    301       !! ** Method  :  - z_star case:  Proportionnaly to the water column thickness. 
    302       !! 
    303       !! ** Action  :  - h(u/v) update wrt ssh/h(u/v)_0 
    304       !! 
    305       !!---------------------------------------------------------------------- 
    306       INTEGER, INTENT( in )           ::   kt             ! time step 
    307       INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step 
    308       INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
    309       ! 
    310       !!---------------------------------------------------------------------- 
    311       ! 
    312       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    313       ! 
    314       IF( ln_timing )   CALL timing_start('dom_h_nxt') 
    315       ! 
    316       IF( kt == nit000 ) THEN 
    317          IF(lwp) WRITE(numout,*) 
    318          IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 
    319          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    320       ENDIF 
    321       ! 
    322       ! *********************************** ! 
    323       ! After depths at u- v points         ! 
    324       ! *********************************** ! 
    325       hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
    326       hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
    327       !                                        ! Inverse of the local depth 
    328       r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
    329       r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
    330       ! 
    331334      IF( ln_timing )   CALL timing_stop('dom_h_nxt') 
    332335      ! 
    333336   END SUBROUTINE dom_h_nxt 
    334337 
    335  
    336    SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 
     338! !!st 
     339!    SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 
     340!       !!---------------------------------------------------------------------- 
     341!       !!                ***  ROUTINE dom_qe_sf_update  *** 
     342!       !! 
     343!       !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
     344!       !!               compute all depths and related variables for next time step 
     345!       !!               write outputs and restart file 
     346!       !! 
     347!       !! ** Method  :  - reconstruct scale factor at other grid points (interpolate) 
     348!       !!               - recompute depths and water height fields 
     349!       !! 
     350!       !! ** Action  :  - Recompute: 
     351!       !!                    e3(u/v)_b 
     352!       !!                    e3w(:,:,:,Kmm) 
     353!       !!                    e3(u/v)w_b 
     354!       !!                    e3(u/v)w_n 
     355!       !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
     356!       !!                    h(u/v) and h(u/v)r 
     357!       !! 
     358!       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
     359!       !!              Leclair, M., and G. Madec, 2011, Ocean Modelling. 
     360!       !!---------------------------------------------------------------------- 
     361!       INTEGER, INTENT( in ) ::   kt              ! time step 
     362!       INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa   ! time level indices 
     363!       ! 
     364!       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     365!       REAL(wp) ::   zcoef        ! local scalar 
     366!       !!---------------------------------------------------------------------- 
     367!       ! 
     368!       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
     369!       ! 
     370!       IF( ln_timing )   CALL timing_start('dom_qe_sf_update') 
     371!       ! 
     372!       IF( kt == nit000 )   THEN 
     373!          IF(lwp) WRITE(numout,*) 
     374!          IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 
     375!          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
     376!       ENDIF 
     377!       ! 
     378!       ! Compute all missing vertical scale factor and depths 
     379!       ! ==================================================== 
     380!       ! Horizontal scale factor interpolations 
     381!       ! -------------------------------------- 
     382!       ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
     383!       ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
     384! 
     385! 
     386!       ! Scale factor computation 
     387!       DO jk = 1, jpk             ! Horizontal interpolation 
     388!          e3f(:,:,jk)      =  e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) )   ! Kmm time level 
     389!          !                       ! Vertical interpolation 
     390!        !                                   ! The ratio does not have to be masked at w-level 
     391!          e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
     392!          e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
     393!          e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
     394!          e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
     395!          e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
     396!          e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
     397!       END DO 
     398! 
     399! 
     400!       IF( ln_isf ) THEN          !** IceShelF cavities 
     401!       !                             ! to be created depending of the new names in isf 
     402!       !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
     403!       !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
     404! !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
     405!          gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
     406!          gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
     407!          gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
     408!          DO jk = 2, jpk 
     409!             gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     410!                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     411!             gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     412!                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     413!             gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
     414!             gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     415!                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     416!             gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     417!                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     418!          END DO 
     419!          ! 
     420!       ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
     421!          ! 
     422! !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
     423!          DO jk = 1, jpk 
     424!             gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     425!             gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     426!             gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
     427!             gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     428!             gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     429!          END DO 
     430!          ! 
     431!       ENDIF 
     432! 
     433!       ! Local depth and Inverse of the local depth of the water 
     434!       ! ------------------------------------------------------- 
     435!       ! 
     436!       ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 
     437! 
     438!       ! write restart file 
     439!       ! ================== 
     440!       IF( lrst_oce  )   CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' ) 
     441!       ! 
     442!       IF( ln_timing )   CALL timing_stop('dom_qe_sf_update') 
     443!       ! 
     444!    END SUBROUTINE dom_qe_sf_update 
     445!!st end 
     446 
     447   SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa ) 
    337448      !!---------------------------------------------------------------------- 
    338449      !!                ***  ROUTINE dom_qe_sf_update  *** 
     
    346457      !! 
    347458      !! ** Action  :  - Recompute: 
    348       !!                    e3(u/v)_b 
    349       !!                    e3w(:,:,:,Kmm) 
    350       !!                    e3(u/v)w_b 
    351       !!                    e3(u/v)w_n 
    352459      !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
    353460      !!                    h(u/v) and h(u/v)r 
     
    377484      ! Horizontal scale factor interpolations 
    378485      ! -------------------------------------- 
    379       ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    380486      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    381  
    382  
    383       ! Scale factor computation 
    384       DO jk = 1, jpk             ! Horizontal interpolation 
    385          e3f(:,:,jk)      =  e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) )   ! Kmm time level 
    386          !                       ! Vertical interpolation 
    387          !                                   ! The ratio does not have to be masked at w-level 
    388          e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
    389          e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
    390          e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
    391          e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
    392          e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
    393          e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
    394       END DO 
    395  
    396487 
    397488      IF( ln_isf ) THEN          !** IceShelF cavities 
     
    399490      !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
    400491      !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
    401 !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
     492   !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
    402493         gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
    403494         gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
     
    417508      ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
    418509         ! 
    419 !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
     510   !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
    420511         DO jk = 1, jpk 
    421512            gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     
    435526      ! write restart file 
    436527      ! ================== 
    437       IF( lrst_oce  )   CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' ) 
    438       ! 
    439528      IF( ln_timing )   CALL timing_stop('dom_qe_sf_update') 
    440529      ! 
    441    END SUBROUTINE dom_qe_sf_update 
     530   END SUBROUTINE dom_h_update 
    442531 
    443532 
     
    507596 
    508597 
    509    SUBROUTINE dom_qe_rst( kt, Kbb, Kmm, cdrw ) 
     598   SUBROUTINE qe_rst_read( kt, Kbb, Kmm ) 
    510599      !!--------------------------------------------------------------------- 
    511       !!                   ***  ROUTINE dom_qe_rst  *** 
    512       !! 
    513       !! ** Purpose :   Read or write VVL file in restart file 
     600      !!                   ***  ROUTINE qe_rst_read  *** 
     601      !! 
     602      !! ** Purpose :   Read ssh in restart file 
    514603      !! 
    515604      !! ** Method  :   use of IOM library 
    516       !!                if the restart does not contain vertical scale factors, 
    517       !!                they are set to the _0 values 
    518       !!                if the restart does not contain vertical scale factors increments (z_tilde), 
    519       !!                they are set to 0. 
     605      !!                if the restart does not contain ssh, 
     606      !!                it is set to the _0 values. 
    520607      !!---------------------------------------------------------------------- 
    521608      INTEGER         , INTENT(in) ::   kt        ! ocean time-step 
    522609      INTEGER         , INTENT(in) ::   Kbb, Kmm  ! ocean time level indices 
    523       CHARACTER(len=*), INTENT(in) ::   cdrw      ! "READ"/"WRITE" flag 
    524610      ! 
    525611      INTEGER ::   ji, jj, jk 
     
    527613      !!---------------------------------------------------------------------- 
    528614      ! 
    529       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    530          !                                   ! =============== 
    531615         IF( ln_rstart ) THEN                   !* Read the restart file 
    532616            CALL rst_read_open                  !  open the restart file if necessary 
    533             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    534617            ! 
    535             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    536             id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
     618            id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 
     619            id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 
    537620            ! 
    538621            !                             ! --------- ! 
     
    541624            ! 
    542625            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    543                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    544                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     626               CALL iom_get( numror, jpdom_autoglo, 'sshb'   , ssh(:,:,Kbb), ldxios = lrxios    ) 
     627               CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    545628               ! needed to restart if land processor not computed 
    546                IF(lwp) write(numout,*) 'dom_qe_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    547                WHERE ( tmask(:,:,:) == 0.0_wp ) 
    548                   e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
    549                   e3t(:,:,:,Kbb) = e3t_0(:,:,:) 
     629               IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 
     630               WHERE ( ssmask(:,:) == 0.0_wp )   !!gm/st ==> sm should not be necessary on ssh when it was required on e3 
     631                  ssh(:,:,Kmm) = 0._wp 
     632                  ssh(:,:,Kbb) = 0._wp 
    550633               END WHERE 
    551634               IF( neuler == 0 ) THEN 
    552                   e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     635                  ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    553636               ENDIF 
    554637            ELSE IF( id1 > 0 ) THEN 
    555                IF(lwp) write(numout,*) 'dom_qe_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 
    556                IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
     638               IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart files' 
     639               IF(lwp) write(numout,*) 'sshn set equal to sshb.' 
    557640               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    558                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    559                e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
     641               CALL iom_get( numror, jpdom_autoglo, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 
     642               ssh(:,:,Kmm) = ssh(:,:,Kbb) 
    560643               neuler = 0 
    561644            ELSE IF( id2 > 0 ) THEN 
    562                IF(lwp) write(numout,*) 'dom_qe_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 
    563                IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
     645               IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kbb) not found in restart files' 
     646               IF(lwp) write(numout,*) 'sshb set equal to sshn.' 
    564647               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    565                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    566                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     648               CALL iom_get( numror, jpdom_autoglo, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 
     649               ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    567650               neuler = 0 
    568651            ELSE 
    569                IF(lwp) write(numout,*) 'dom_qe_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 
    570                IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
     652               IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart file' 
     653               IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero' 
    571654               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    572                DO jk = 1, jpk 
    573                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    574                       &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    575                       &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk)) 
    576                END DO 
    577                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     655               ssh(:,:,:) = 0._wp 
    578656               neuler = 0 
    579657            ENDIF 
     
    583661            IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential 
    584662               ! 
    585                IF( cn_cfg == 'wad' ) THEN 
    586                   ! Wetting and drying test case 
     663               IF( cn_cfg == 'wad' ) THEN            ! Wetting and drying test case 
    587664                  CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    588                   ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    589                   ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
    590                   uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    591                   vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    592                ELSE 
    593                   ! if not test case 
     665                  ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     666                  ssh(:,:    ,Kmm) = ssh(:,:    ,Kbb) 
     667                  uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
     668                  vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
     669               ELSE                                  ! if not test case 
    594670                  ssh(:,:,Kmm) = -ssh_ref 
    595671                  ssh(:,:,Kbb) = -ssh_ref 
    596  
     672                  ! 
    597673                  DO_2D_11_11 
    598674                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
     
    601677                     ENDIF 
    602678                  END_2D 
    603                ENDIF !If test case else 
    604  
    605                ! Adjust vertical metrics for all wad 
    606                DO jk = 1, jpk 
    607                   e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) ) 
    608                END DO 
    609                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     679               ENDIF 
    610680 
    611681               DO ji = 1, jpi 
    612682                  DO jj = 1, jpj 
    613683                     IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    614                        CALL ctl_stop( 'dom_qe_rst: ht_0 must be positive at potentially wet points' ) 
     684                       CALL ctl_stop( 'qe_rst_read: ht_0 must be positive at potentially wet points' ) 
    615685                     ENDIF 
    616686                  END DO 
     
    623693!               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    624694!               ! 
    625 !               DO jk=1,jpk 
    626 !                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
    627 !                     &            / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 
    628 !               END DO 
    629 !               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    630                 ssh(:,:,Kmm)=0._wp 
    631                 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 
    632                 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 
     695                ssh(:,:,:) = 0._wp 
    633696               ! 
    634697            ENDIF           ! end of ll_wd edits 
    635698            ! 
    636699         ENDIF 
    637          ! 
    638       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    639          !                                   ! =================== 
    640          IF(lwp) WRITE(numout,*) '---- dom_qe_rst ----' 
    641          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    642          !                                           ! --------- ! 
    643          !                                           ! all cases ! 
    644          !                                           ! --------- ! 
    645          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    646          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
    647          ! 
    648          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    649       ENDIF 
    650       ! 
    651    END SUBROUTINE dom_qe_rst 
     700      ! 
     701   END SUBROUTINE qe_rst_read 
    652702 
    653703 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domvvl.F90

    r12482 r12680  
    1212   !!---------------------------------------------------------------------- 
    1313 
    14    !!---------------------------------------------------------------------- 
    15    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    16    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
    17    !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
    18    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
    19    !!   dom_vvl_rst      : read/write restart file 
    20    !!   dom_vvl_ctl      : Check the vvl options 
    21    !!---------------------------------------------------------------------- 
    2214   USE oce             ! ocean dynamics and tracers 
    2315   USE phycst          ! physical constant 
     
    3628   IMPLICIT NONE 
    3729   PRIVATE 
    38  
    39    PUBLIC  dom_vvl_init       ! called by domain.F90 
    40    PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
    41    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    42    PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    43    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    44  
     30    
    4531   !                                                      !!* Namelist nam_vvl 
    4632   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate 
     
    6450   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6551 
     52#if defined key_qco 
     53   !!---------------------------------------------------------------------- 
     54   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     55   !!---------------------------------------------------------------------- 
     56#else 
     57   !!---------------------------------------------------------------------- 
     58   !!   Default key      Old management of time varying vertical coordinate 
     59   !!---------------------------------------------------------------------- 
     60    
     61   !!---------------------------------------------------------------------- 
     62   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     63   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
     64   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
     65   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
     66   !!   dom_vvl_rst      : read/write restart file 
     67   !!   dom_vvl_ctl      : Check the vvl options 
     68   !!---------------------------------------------------------------------- 
     69 
     70   PUBLIC  dom_vvl_init       ! called by domain.F90 
     71   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
     72   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
     73   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
     74   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
     75    
    6676   !! * Substitutions 
    6777#  include "do_loop_substitute.h90" 
     
    136146      ! 
    137147   END SUBROUTINE dom_vvl_init 
    138    ! 
     148 
     149 
    139150   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
    140151      !!---------------------------------------------------------------------- 
     
    10391050   END SUBROUTINE dom_vvl_ctl 
    10401051 
     1052#endif 
     1053 
    10411054   !!====================================================================== 
    10421055END MODULE domvvl 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90

    r12656 r12680  
    1212!!---------------------------------------------------------------------- 
    1313#if defined key_qco 
    14 #   define  e3t(i,j,k,t)   (e3t_0(i,j,k)*(1.+r3t(i,j,t)*tmask(i,j,k))) 
    15 #   define  e3u(i,j,k,t)   (e3u_0(i,j,k)*(1.+r3u(i,j,t)*umask(i,j,k))) 
    16 #   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1.+r3v(i,j,t)*vmask(i,j,k))) 
    17 #   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1.+r3f(i,j)*fmask(i,j,k))) 
    18 #   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1.+r3t(i,j,t))) 
    19 #   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1.+r3u(i,j,t))) 
    20 #   define  e3vw(i,j,k,t)  (e3vw_0(i,j,k)*(1.+r3v(i,j,t))) 
     14#   define  e3t(i,j,k,t)   (e3t_0(i,j,k)*(1._wp+r3t(i,j,t)*tmask(i,j,k))) 
     15#   define  e3u(i,j,k,t)   (e3u_0(i,j,k)*(1._wp+r3u(i,j,t)*umask(i,j,k))) 
     16#   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1._wp+r3v(i,j,t)*vmask(i,j,k))) 
     17#   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fmask(i,j,k))) 
     18#   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 
     19#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 
     20#   define  e3vw(i,j,k,t)  (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 
    2121#endif 
    2222!!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/istate.F90

    r12377 r12680  
    4343   !! * Substitutions 
    4444#  include "do_loop_substitute.h90" 
     45#  include "domzgr_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf.F90

    r12581 r12680  
    5858 
    5959   PUBLIC    dyn_atf   ! routine called by step.F90 
     60 
     61#if defined key_qco 
     62   !!---------------------------------------------------------------------- 
     63   !!   'key_qco'      EMPTY ROUTINE     Quasi-Eulerian vertical coordonate 
     64   !!---------------------------------------------------------------------- 
     65CONTAINS 
     66 
     67   SUBROUTINE dyn_atf ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 
     68      INTEGER                             , INTENT(in   ) :: kt               ! ocean time-step index 
     69      INTEGER                             , INTENT(in   ) :: Kbb, Kmm, Kaa    ! before and after time level indices 
     70      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered 
     72 
     73      WRITE(*,*) 'dyn_atf: You should not have seen this print! error?', kt 
     74   END SUBROUTINE dyn_atf 
     75 
     76#else 
    6077 
    6178   !! * Substitutions 
     
    314331   END SUBROUTINE dyn_atf 
    315332 
     333#endif 
     334 
    316335   !!========================================================================= 
    317336END MODULE dynatf 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/sshwzv.F90

    r12622 r12680  
    114114      ! 
    115115#if defined key_agrif 
    116       Kbb_a = Kbb; Kmm_a = Kmm; Krhs_a = Kaa; CALL agrif_ssh( kt ) 
     116      Kbb_a = Kbb   ;   Kmm_a = Kmm   ;   Krhs_a = Kaa 
     117      CALL agrif_ssh( kt ) 
    117118#endif 
    118119      ! 
     
    134135 
    135136 
    136    SUBROUTINE wzv( kt, Kbb, Kmm, pww, Kaa ) 
     137   SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww ) 
    137138      !!---------------------------------------------------------------------- 
    138139      !!                ***  ROUTINE wzv  *** 
     
    151152      INTEGER                         , INTENT(in)    ::   kt             ! time step 
    152153      INTEGER                         , INTENT(in)    ::   Kbb, Kmm, Kaa  ! time level indices 
    153       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pww            ! now vertical velocity 
     154      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pww            ! vertical velocity at Kmm 
    154155      ! 
    155156      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    165166         IF(lwp) WRITE(numout,*) '~~~~~ ' 
    166167         ! 
    167          pww(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    168       ENDIF 
    169       !                                           !------------------------------! 
    170       !                                           !     Now Vertical Velocity    ! 
    171       !                                           !------------------------------! 
    172       z1_2dt = 1. / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog) 
     168         pww(:,:,jpk) = 0._wp           ! bottom boundary condition: w=0 (set once for all) 
     169      ENDIF 
     170      ! 
     171      z1_2dt = 1. / ( 2. * rdt )        ! set time step size (Euler/Leapfrog) 
    173172      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1. / rdt 
    174173      ! 
    175       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
     174      !                                               !===============================! 
     175      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      !==  z_tilde and layer cases  ==! 
     176         !                                            !===============================! 
    176177         ALLOCATE( zhdiv(jpi,jpj,jpk) ) 
    177178         ! 
     
    188189         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    189190            ! computation of w 
    190             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)    & 
    191                &                         + zhdiv(:,:,jk)                       & 
    192                &                         + z1_2dt * ( e3t(:,:,jk,Kaa)          & 
    193                &                                    - e3t(:,:,jk,Kbb) )  ) * tmask(:,:,jk) 
     191            pww(:,:,jk) = pww(:,:,jk+1) - (   e3t(:,:,jk,Kmm) * hdiv(:,:,jk)   & 
     192               &                            +                  zhdiv(:,:,jk)   & 
     193               &                            + z1_2dt * ( e3t(:,:,jk,Kaa)       & 
     194               &                                       - e3t(:,:,jk,Kbb) )   ) * tmask(:,:,jk) 
    194195         END DO 
    195196         !          IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 
    196197         DEALLOCATE( zhdiv ) 
    197       ELSE   ! z_star and linear free surface cases 
    198          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    199             ! computation of w 
     198         !                                            !=================================! 
     199      ELSEIF( ln_linssh )   THEN                      !==  linear free surface cases  ==! 
     200         !                                            !=================================! 
     201         DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
     202            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)  ) * tmask(:,:,jk) 
     203         END DO 
     204         !                                            !==========================================! 
     205      ELSE                                            !==  Quasi-Eulerian vertical coordinate  ==!   ('key_qco') 
     206         !                                            !==========================================! 
     207         DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
    200208            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)    & 
    201209               &                         + z1_2dt * ( e3t(:,:,jk,Kaa)          & 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/IOM/restart.F90

    r12377 r12680  
    285285      ! 
    286286      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    287          ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
    288          uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm) 
    289          vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm) 
    290          ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm) 
    291          ! 
    292          IF( .NOT.ln_linssh ) THEN 
    293             DO jk = 1, jpk 
    294                e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    295             END DO 
    296          ENDIF 
    297          ! 
     287         ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm)                  ! all before fields set to now values 
     288         uu (:,:,:  ,Kbb) = uu (:,:,:  ,Kmm) 
     289         vv (:,:,:  ,Kbb) = vv (:,:,:  ,Kmm) 
     290         ssh(:,:    ,Kbb) = ssh(:,:    ,Kmm) 
    298291      ENDIF 
    299292      ! 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90

    r12656 r12680  
    226226#if ! defined key_qco 
    227227      DO jk = 1, jpk 
    228          e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    229              &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    230              &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk)) 
     228         e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + (ht_0(:,:) + ssh(:,:,Kmm)) * r1_ht_0(:,:) ) 
    231229      END DO 
    232230      e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcice_cice.F90

    r12656 r12680  
    239239               ! 
    240240               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    241                   e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    242                   e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    243                ENDDO 
     241                  e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*r1_ht_0(:,:)*tmask(:,:,jk) ) 
     242                  e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*r1_ht_0(:,:)*tmask(:,:,jk) ) 
     243               END DO 
    244244               e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 
    245245               ! Reconstruction of all vertical scale factors at now and before time-steps 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traatf.F90

    r12656 r12680  
    132132         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms 
    133133         DO jk = 1, jpkm1 
    134             ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa)   & 
    135                &                                   / e3t(:,:,jk,Kmm)   & 
    136                &            - pts(:,:,jk,jp_tem,Kmm)) * zfact 
    137             ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa)   & 
    138                &                                   / e3t(:,:,jk,Kmm)   & 
    139                &            - pts(:,:,jk,jp_sal,Kmm)) * zfact 
     134            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact 
     135            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact 
    140136         END DO 
    141137         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt ) 
     
    336332                  IF ( jk == misfkb_cav(ji,jj) ) THEN 
    337333                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) )  & 
    338                             &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)   & 
    339                             &                 * rfrac_tbl_cav(ji,jj) 
     334                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj) 
    340335                  END IF 
    341336               END IF 
     
    351346                  IF ( jk == misfkb_par(ji,jj) ) THEN 
    352347                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  & 
    353                             &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)   & 
    354                             &                 * rfrac_tbl_par(ji,jj) 
     348                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj) 
    355349                  END IF 
    356350               END IF 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/step.F90

    r12377 r12680  
    3333   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 
    3434   !!---------------------------------------------------------------------- 
    35  
     35#if defined key_qco 
     36   !!---------------------------------------------------------------------- 
     37   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     38   !!---------------------------------------------------------------------- 
     39#else 
    3640   !!---------------------------------------------------------------------- 
    3741   !!   stp             : OPA system time-stepping 
     
    171175                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor) 
    172176      IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors  
    173                             CALL wzv           ( kstp, Nbb, Nnn, ww,  Naa )    ! now cross-level velocity  
     177                            CALL wzv           ( kstp, Nbb, Nnn, Naa, ww )    ! now cross-level velocity  
    174178      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning 
    175179                            CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) )  ! now in situ density for hpg computation 
     
    200204                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
    201205      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    202                             CALL wzv        ( kstp, Nbb, Nnn, ww, Naa )             ! now cross-level velocity  
     206                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! now cross-level velocity  
    203207         IF( ln_zad_Aimp )  CALL wAimp      ( kstp,      Nnn )                      ! Adaptive-implicit vertical advection partitioning 
    204208      ENDIF 
     
    339343   END SUBROUTINE stp 
    340344   ! 
     345#endif 
    341346   !!====================================================================== 
    342347END MODULE step 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90

    r12679 r12680  
    5555   !!---------------------------------------------------------------------- 
    5656   INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs          !! used by nemo_init 
    57  
    5857#  include "domzgr_substitute.h90" 
    5958   !!---------------------------------------------------------------------- 
     
    185184      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    186185 
    187                             CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor) 
     186                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh,  Naa )    ! after ssh (includes call to div_hor) 
    188187      IF( .NOT.ln_linssh )  CALL dom_qe_r3c    ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 
    189       IF( .NOT.ln_linssh )  CALL dom_h_nxt     ( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
     188      IF( .NOT.ln_linssh )  CALL dom_h_nxt     ( kstp, Nbb, Nnn,       Naa )    ! after vertical scale factors 
    190189      !IF( .NOT.ln_linssh )  CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
    191                             CALL wzv           ( kstp, Nbb, Nnn, ww,  Naa )    ! now cross-level velocity 
     190                            CALL wzv           ( kstp, Nbb, Nnn, Naa, ww  )    ! Nnn cross-level velocity 
    192191      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning 
    193192                            CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) )  ! now in situ density for hpg computation 
     
    213212                                                      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 
    214213      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated 
    215                             CALL div_hor       ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
    216          IF(.NOT.ln_linssh) CALL dom_qe_r3c    ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 
    217          IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    218          !IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
     214                            CALL div_hor    ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
     215         IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 
     216         !IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
     217         IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    219218      ENDIF 
    220219                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
    221220      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    222                             CALL wzv        ( kstp, Nbb, Nnn, ww, Naa )             ! now cross-level velocity 
     221                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity 
    223222         IF( ln_zad_Aimp )  CALL wAimp      ( kstp,      Nnn )                      ! Adaptive-implicit vertical advection partitioning 
    224223      ENDIF 
     
    294293!!    place. 
    295294!! 
    296 !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    297                          CALL zdyn_ts       ( Nnn, Naa, e3u, e3v, uu, vv )                   ! barotrope ajustment 
     295                         CALL zdyn_ts       ( Nnn, Naa, uu, vv )                   ! barotrope ajustment 
    298296                         CALL finalize_sbc  ( kstp, Nbb, Naa, uu, vv, ts )                   ! boundary condifions 
    299297                         CALL ssh_atf       ( kstp, Nbb, Nnn, Naa, ssh )                     ! time filtering of "now" sea surface height 
    300298                         CALL dom_qe_r3c    ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )            ! "now" ssh/h_0 ratio from filtrered ssh 
    301299                         CALL tra_atf_qco   ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
    302                          CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv )  ! time filtering of "now" velocities and scale factors 
     300                         CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv  )  ! time filtering of "now" velocities and scale factors 
    303301                         r3t(:,:,Nnn) = r3t_f(:,:) 
    304302                         r3u(:,:,Nnn) = r3u_f(:,:) 
     
    312310      Naa = Nrhs 
    313311      ! 
    314       IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors 
     312      !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors 
     313      IF(.NOT.ln_linssh) CALL dom_h_update  ( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors 
    315314      ! 
    316315      IF( ln_diahsb  )   CALL dia_hsb       ( kstp, Nbb, Nnn )  ! - ML - global conservation diagnostics 
     
    367366 
    368367 
    369    SUBROUTINE zdyn_ts (Kmm, Kaa, pe3u, pe3v, puu, pvv) 
     368   SUBROUTINE zdyn_ts (Kmm, Kaa, puu, pvv) 
    370369      !!---------------------------------------------------------------------- 
    371370      !!                  ***  ROUTINE zdyn_ts  *** 
     
    380379      INTEGER                             , INTENT(in   ) :: Kmm, Kaa    ! before and after time level indices 
    381380      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities 
    382       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in   ) :: pe3u, pe3v   ! scale factors 
    383381      ! 
    384382      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve 
     
    391389         ! Ensure below that barotropic velocities match time splitting estimate 
    392390         ! Compute actual transport and replace it with ts estimate at "after" time step 
    393          zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
    394          zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
     391         zue(:,:) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
     392         zve(:,:) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
    395393         DO jk = 2, jpkm1 
    396             zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
    397             zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
     394            zue(:,:) = zue(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
     395            zve(:,:) = zve(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    398396         END DO 
    399397         DO jk = 1, jpkm1 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/C14/trcsms_c14.F90

    r12377 r12680  
    2828   !! * Substitutions 
    2929#  include "do_loop_substitute.h90" 
     30#  include "domzgr_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    3132   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/CFC/trcsms_cfc.F90

    r12377 r12680  
    4949   !! * Substitutions 
    5050#  include "do_loop_substitute.h90" 
     51#  include "domzgr_substitute.h90" 
    5152   !!---------------------------------------------------------------------- 
    5253   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zbio.F90

    r12377 r12680  
    5858   !! * Substitutions 
    5959#  include "do_loop_substitute.h90" 
     60#  include "domzgr_substitute.h90" 
    6061   !!---------------------------------------------------------------------- 
    6162   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zexp.F90

    r12377 r12680  
    3939   !! * Substitutions 
    4040#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zopt.F90

    r12377 r12680  
    4040   !! * Substitutions 
    4141#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zsed.F90

    r12377 r12680  
    3333   !! * Substitutions 
    3434#  include "do_loop_substitute.h90" 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zbc.F90

    r12377 r12680  
    4848   !! * Substitutions 
    4949#  include "do_loop_substitute.h90" 
     50#  include "domzgr_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zflx.F90

    r12377 r12680  
    5454   !! * Substitutions 
    5555#  include "do_loop_substitute.h90" 
     56#  include "domzgr_substitute.h90" 
    5657   !!---------------------------------------------------------------------- 
    5758   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zopt.F90

    r12377 r12680  
    4444   !! * Substitutions 
    4545#  include "do_loop_substitute.h90" 
     46#  include "domzgr_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zpoc.F90

    r12377 r12680  
    3939   !! * Substitutions 
    4040#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zrem.F90

    r12377 r12680  
    4444   !! * Substitutions 
    4545#  include "do_loop_substitute.h90" 
     46#  include "domzgr_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zsed.F90

    r12377 r12680  
    3939   !! * Substitutions 
    4040#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zsms.F90

    r12377 r12680  
    4141   !! * Substitutions 
    4242#  include "do_loop_substitute.h90" 
     43#  include "domzgr_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/oce_sed.F90

    r12377 r12680  
    1313   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    1414   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    15   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
     15!!st USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
    1616   USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m) 
    1717   USE dom_oce , ONLY :   gdepw_0   =>   gdepw_0        !: reference depth of t-points (m) 
     
    5353 
    5454END MODULE oce_sed 
    55  
    56  
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/seddta.F90

    r12377 r12680  
    2424   !! * Substitutions 
    2525#  include "do_loop_substitute.h90" 
     26#  include "domzgr_substitute.h90" 
    2627   !! $Id$ 
    2728CONTAINS 
     
    164165      CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 
    165166      rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 
    166       ! vector temperature [°C] and salinity  
     167      ! vector temperature [C] and salinity  
    167168      CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 
    168169      CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,16), iarroce(1:jpoce) ) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcsink.F90

    r12377 r12680  
    2626   !! * Substitutions 
    2727#  include "do_loop_substitute.h90" 
     28#  include "domzgr_substitute.h90" 
    2829   !!---------------------------------------------------------------------- 
    2930   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
Note: See TracChangeset for help on using the changeset viewer.