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 13334 for NEMO/branches/2020 – NEMO

Changeset 13334 for NEMO/branches/2020


Ignore:
Timestamp:
2020-07-22T16:20:32+02:00 (4 years ago)
Author:
jchanut
Message:

finish bypassing ocean/ice initialization with AGRIF, #2222, #2129

Location:
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/ICE/iceistate.F90

    r13295 r13334  
    3333   USE fldread        ! read input fields 
    3434 
    35 # if defined key_agrif 
    36    USE agrif_oce 
    37    USE agrif_ice 
    38    USE agrif_ice_interp  
    39 # endif    
     35   USE agrif_oce      ! initial state interpolation 
     36   USE agrif_ice_interp    
    4037 
    4138   IMPLICIT NONE 
     
    177174 
    178175      IF( ln_iceini ) THEN 
    179          !                             !---------------! 
    180           
    181          IF( Agrif_Root() ) THEN 
    182  
     176         
     177#if defined key_agrif 
     178         IF ( ( Agrif_Root() ).OR.(.NOT.ln_init_chfrpar ) ) THEN 
     179#endif 
     180            !                             !---------------! 
    183181            IF( ln_iceini_file )THEN      ! Read a file   ! 
    184182               !                          !---------------! 
     
    376374            t1_ice(:,:,:) = t_i (:,:,1,:) 
    377375            ! 
    378           
    379 #if  defined key_agrif 
     376#if defined key_agrif 
    380377         ELSE 
    381   
    382             Agrif_SpecialValue    = -9999. 
    383             Agrif_UseSpecialValue = .TRUE. 
    384             CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 
    385             use_sign_north = .TRUE. 
    386             sign_north = -1. 
    387             CALL Agrif_init_variable(u_iceini_id  ,procname=interp_u_ice) 
    388             CALL Agrif_init_variable(v_iceini_id  ,procname=interp_v_ice) 
    389             Agrif_SpecialValue    = 0._wp 
    390             use_sign_north = .FALSE. 
    391             Agrif_UseSpecialValue = .FALSE. 
    392         ! lbc ????  
    393    ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i 
    394             CALL ice_var_glo2eqv 
    395             CALL ice_var_zapsmall 
    396             CALL ice_var_agg(2) 
    397  
    398             ! Melt ponds 
    399             WHERE( a_i > epsi10 ) 
    400                a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
    401             ELSEWHERE 
    402                a_ip_frac(:,:,:) = 0._wp 
    403             END WHERE 
    404             WHERE( a_ip > 0._wp )       ! ???????     
    405                h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
    406             ELSEWHERE 
    407                h_ip(:,:,:) = 0._wp 
    408             END WHERE    
    409  
    410             tn_ice(:,:,:) = t_su(:,:,:) 
    411             t1_ice(:,:,:) = t_i (:,:,1,:) 
     378            CALL  agrif_istate_ice         
     379         ENDIF 
    412380#endif 
    413           ENDIF ! Agrif_Root 
    414381      ENDIF ! ln_iceini 
    415382      ! 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/ICE/icerst.F90

    r13286 r13334  
    2525   USE lib_mpp        ! MPP library 
    2626   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
     27 
     28   USE agrif_oce      ! initial state interpolation 
     29   USE agrif_ice_interp   
    2730 
    2831   IMPLICIT NONE 
     
    185188      ENDIF 
    186189 
    187       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 
    188  
    189       ! test if v_i exists  
    190       id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 
    191  
    192       !                    ! ------------------------------ ! 
    193       IF( id0 > 0 ) THEN   ! == case of a normal restart == ! 
    194          !                 ! ------------------------------ ! 
     190#if defined key_agrif 
     191      IF( (.NOT.Agrif_Root()).AND.ln_init_chfrpar ) THEN 
     192         !                 ! -------------------------------- ! 
     193         !                 ! == set ice fields from parent == ! 
     194         !                 ! -------------------------------- ! 
     195         ! 
     196         CALL agrif_istate_ice 
     197         ! 
     198      ELSE 
     199#endif 
     200 
     201         CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 
     202 
     203         ! test if v_i exists  
     204         id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 
     205 
     206         !                    ! ------------------------------ ! 
     207         IF( id0 > 0 ) THEN   ! == case of a normal restart == ! 
     208            !                 ! ------------------------------ ! 
    195209          
    196          ! Time info 
    197          CALL iom_get( numrir, 'nn_fsbc', zfice ) 
    198          CALL iom_get( numrir, 'kt_ice' , ziter )     
    199          IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
    200          IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
    201  
    202          ! Control of date 
    203          IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
    204             &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  & 
    205             &                   '   verify the file or rerun with the value 0 for the',        & 
    206             &                   '   control of time parameter  nrstdt' ) 
    207          IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
    208             &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
    209             &                   '   verify the file or rerun with the value 0 for the',         & 
    210             &                   '   control of time parameter  nrstdt' ) 
    211  
    212          ! --- mandatory fields --- !  
    213          CALL iom_get( numrir, jpdom_auto, 'v_i'  , v_i   ) 
    214          CALL iom_get( numrir, jpdom_auto, 'v_s'  , v_s   ) 
    215          CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i  ) 
    216          CALL iom_get( numrir, jpdom_auto, 'a_i'  , a_i   ) 
    217          CALL iom_get( numrir, jpdom_auto, 't_su' , t_su  ) 
    218          CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp ) 
    219          CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp ) 
    220          ! Snow enthalpy 
    221          DO jk = 1, nlay_s 
    222             WRITE(zchar1,'(I2.2)') jk 
    223             znam = 'e_s'//'_l'//zchar1 
    224             CALL iom_get( numrir, jpdom_auto, znam , z3d ) 
    225             e_s(:,:,jk,:) = z3d(:,:,:) 
    226          END DO 
    227          ! Ice enthalpy 
    228          DO jk = 1, nlay_i 
    229             WRITE(zchar1,'(I2.2)') jk 
    230             znam = 'e_i'//'_l'//zchar1 
    231             CALL iom_get( numrir, jpdom_auto, znam , z3d ) 
    232             e_i(:,:,jk,:) = z3d(:,:,:) 
    233          END DO 
    234          ! -- optional fields -- ! 
    235          ! ice age 
    236          id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 
    237          IF( id1 > 0 ) THEN                       ! fields exist 
    238             CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i ) 
    239          ELSE                                     ! start from rest 
    240             IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero' 
    241             oa_i(:,:,:) = 0._wp 
     210            ! Time info 
     211            CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     212            CALL iom_get( numrir, 'kt_ice' , ziter )     
     213            IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
     214            IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
     215 
     216            ! Control of date 
     217            IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
     218               &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  & 
     219               &                   '   verify the file or rerun with the value 0 for the',        & 
     220               &                   '   control of time parameter  nrstdt' ) 
     221            IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
     222               &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
     223               &                   '   verify the file or rerun with the value 0 for the',         & 
     224               &                   '   control of time parameter  nrstdt' ) 
     225 
     226            ! --- mandatory fields --- !  
     227            CALL iom_get( numrir, jpdom_auto, 'v_i'  , v_i   ) 
     228            CALL iom_get( numrir, jpdom_auto, 'v_s'  , v_s   ) 
     229            CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i  ) 
     230            CALL iom_get( numrir, jpdom_auto, 'a_i'  , a_i   ) 
     231            CALL iom_get( numrir, jpdom_auto, 't_su' , t_su  ) 
     232            CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp ) 
     233            CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp ) 
     234            ! Snow enthalpy 
     235            DO jk = 1, nlay_s 
     236               WRITE(zchar1,'(I2.2)') jk 
     237               znam = 'e_s'//'_l'//zchar1 
     238               CALL iom_get( numrir, jpdom_auto, znam , z3d ) 
     239               e_s(:,:,jk,:) = z3d(:,:,:) 
     240            END DO 
     241            ! Ice enthalpy 
     242            DO jk = 1, nlay_i 
     243               WRITE(zchar1,'(I2.2)') jk 
     244               znam = 'e_i'//'_l'//zchar1 
     245               CALL iom_get( numrir, jpdom_auto, znam , z3d ) 
     246               e_i(:,:,jk,:) = z3d(:,:,:) 
     247            END DO 
     248            ! -- optional fields -- ! 
     249            ! ice age 
     250            id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 
     251            IF( id1 > 0 ) THEN                       ! fields exist 
     252               CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i ) 
     253            ELSE                                     ! start from rest 
     254               IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero' 
     255               oa_i(:,:,:) = 0._wp 
     256            ENDIF 
     257            ! melt ponds 
     258            id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 
     259            IF( id2 > 0 ) THEN                       ! fields exist 
     260               CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip ) 
     261               CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip ) 
     262            ELSE                                     ! start from rest 
     263               IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
     264               a_ip(:,:,:) = 0._wp 
     265               v_ip(:,:,:) = 0._wp 
     266            ENDIF 
     267            ! fields needed for Met Office (Jules) coupling 
     268            IF( ln_cpl ) THEN 
     269               id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
     270               id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
     271               IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
     272                  CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 
     273                  CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice  ) 
     274               ELSE                                     ! start from rest 
     275                  IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero' 
     276                  cnd_ice(:,:,:) = 0._wp 
     277                  t1_ice (:,:,:) = rt0 
     278               ENDIF 
     279            ENDIF 
     280 
     281            CALL iom_delay_rst( 'READ', 'ICE', numrir )   ! read only ice delayed global communication variables 
     282 
     283            !                 ! ---------------------------------- ! 
     284         ELSE                 ! == case of a simplified restart == ! 
     285            !                 ! ---------------------------------- ! 
     286            CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 
     287            ! 
     288            CALL ice_istate_init 
     289            CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
     290            ! 
     291            IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
     292               &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
     293            ! 
    242294         ENDIF 
    243          ! melt ponds 
    244          id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 
    245          IF( id2 > 0 ) THEN                       ! fields exist 
    246             CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip ) 
    247             CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip ) 
    248          ELSE                                     ! start from rest 
    249             IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
    250             a_ip(:,:,:) = 0._wp 
    251             v_ip(:,:,:) = 0._wp 
    252          ENDIF 
    253          ! fields needed for Met Office (Jules) coupling 
    254          IF( ln_cpl ) THEN 
    255             id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
    256             id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
    257             IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
    258                CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 
    259                CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice  ) 
    260             ELSE                                     ! start from rest 
    261                IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero' 
    262                cnd_ice(:,:,:) = 0._wp 
    263                t1_ice (:,:,:) = rt0 
    264             ENDIF 
    265          ENDIF 
    266  
    267          CALL iom_delay_rst( 'READ', 'ICE', numrir )   ! read only ice delayed global communication variables 
    268  
    269          !                 ! ---------------------------------- ! 
    270       ELSE                 ! == case of a simplified restart == ! 
    271          !                 ! ---------------------------------- ! 
    272          CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 
    273          ! 
    274          CALL ice_istate_init 
    275          CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
    276          ! 
    277          IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
    278             &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
    279          ! 
    280       ENDIF 
     295#if defined key_agrif 
     296      ENDIF 
     297#endif 
    281298 
    282299   END SUBROUTINE ice_rst_read 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_ice_interp.F90

    r13286 r13334  
    2525   USE agrif_oce 
    2626   USE phycst , ONLY: rt0 
     27   USE icevar 
     28   USE sbc_ice, ONLY : tn_ice 
    2729    
    2830   IMPLICIT NONE 
     
    3032 
    3133   PUBLIC   agrif_interp_ice   ! called by agrif_user.F90 
    32    PUBLIC   interp_tra_ice, interp_u_ice, interp_v_ice  ! called by iceistate.F90 
     34   PUBLIC   agrif_istate_ice   ! called by icerst.F90 
    3335 
    3436   !!---------------------------------------------------------------------- 
     
    3941 
    4042CONTAINS 
     43 
     44   SUBROUTINE agrif_istate_ice 
     45      !!----------------------------------------------------------------------- 
     46      !!                 *** ROUTINE agrif_istate_ice  *** 
     47      !! 
     48      !!  ** Method  : Set initial ice fields from parent grid 
     49      !! 
     50      !!----------------------------------------------------------------------- 
     51      IF(lwp) WRITE(numout,*) ' ' 
     52      IF(lwp) WRITE(numout,*) 'Agrif_istate_ice : interp child ice initial state from parent' 
     53      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
     54      IF(lwp) WRITE(numout,*) ' ' 
     55 
     56      ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i: 
     57      Agrif_SpecialValue    = -9999. 
     58      Agrif_UseSpecialValue = .TRUE. 
     59      CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 
     60      ! 
     61      ! Set u_ice, v_ice: 
     62      use_sign_north = .TRUE. 
     63      sign_north = -1. 
     64      Agrif_UseSpecialValue = .TRUE. 
     65      CALL Agrif_init_variable(u_iceini_id  ,procname=interp_u_ice) 
     66      CALL Agrif_init_variable(v_iceini_id  ,procname=interp_v_ice) 
     67      Agrif_SpecialValue = 0._wp 
     68      use_sign_north = .FALSE. 
     69      Agrif_UseSpecialValue = .FALSE. 
     70      ! lbc ???? 
     71      ! JC: do we really need the 3 lines below ? 
     72      CALL ice_var_glo2eqv 
     73      CALL ice_var_zapsmall 
     74      CALL ice_var_agg(2) 
     75 
     76      ! Melt ponds 
     77      WHERE( a_i > epsi10 ) 
     78         a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     79      ELSEWHERE 
     80         a_ip_frac(:,:,:) = 0._wp 
     81      END WHERE 
     82      WHERE( a_ip > 0._wp )       ! ???????     
     83         h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
     84      ELSEWHERE 
     85         h_ip(:,:,:) = 0._wp 
     86      END WHERE    
     87 
     88      tn_ice(:,:,:) = t_su(:,:,:) 
     89      t1_ice(:,:,:) = t_i (:,:,1,:)  
     90 
     91   END SUBROUTINE agrif_istate_ice 
    4192 
    4293   SUBROUTINE agrif_interp_ice( cd_type, kiter, kitermax ) 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce.F90

    r13286 r13334  
    116116      ! 
    117117   END FUNCTION agrif_oce_alloc 
    118  
    119118#endif 
    120119   !!====================================================================== 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_interp.F90

    r13286 r13334  
    4646   PUBLIC   interpe3t, interpglamt, interpgphit 
    4747   PUBLIC   interpht0, interpmbkt 
    48    PUBLIC   agrif_initts, agrif_initssh 
     48   PUBLIC   agrif_istate_oce, agrif_istate_ssh   ! called by icestate.F90 and domvvl.F90 
    4949 
    5050   INTEGER ::   bdy_tinterp = 0 
     
    5656   !!---------------------------------------------------------------------- 
    5757CONTAINS 
     58 
     59   SUBROUTINE Agrif_istate_oce( Kbb, Kmm, Kaa ) 
     60      !!---------------------------------------------------------------------- 
     61      !!                 *** ROUTINE agrif_istate_oce *** 
     62      !! 
     63      !!                 set initial t, s, u, v, ssh from parent 
     64      !!---------------------------------------------------------------------- 
     65      ! 
     66      IMPLICIT NONE 
     67      ! 
     68      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
     69      INTEGER :: jn 
     70      !!---------------------------------------------------------------------- 
     71      IF(lwp) WRITE(numout,*) ' ' 
     72      IF(lwp) WRITE(numout,*) 'Agrif_istate_oce : interp child initial state from parent' 
     73      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
     74      IF(lwp) WRITE(numout,*) ' ' 
     75 
     76      IF ( ln_rstart ) &  
     77         & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 
     78 
     79      IF ( .NOT.Agrif_Parent(ln_1st_euler) ) &  
     80         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 
     81 
     82      l_ini_child           = .TRUE. 
     83      Agrif_SpecialValue    = 0.0_wp 
     84      Agrif_UseSpecialValue = .TRUE. 
     85 
     86      ts(:,:,:,:,:) = 0.0_wp 
     87      uu(:,:,:,:)   = 0.0_wp 
     88      vv(:,:,:,:)   = 0.0_wp  
     89      ssh(:,:,:)    = 0._wp 
     90        
     91      Krhs_a = Kbb   ;   Kmm_a = Kbb 
     92 
     93      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
     94      CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 
     95 
     96      Agrif_UseSpecialValue = ln_spc_dyn 
     97      use_sign_north = .TRUE. 
     98      sign_north = -1._wp 
     99      CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
     100      CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
     101      use_sign_north = .FALSE. 
     102 
     103      Agrif_UseSpecialValue = .FALSE. 
     104      l_ini_child           = .FALSE. 
     105 
     106      Krhs_a = Kaa   ;   Kmm_a = Kmm 
     107 
     108      ssh(:,:,Kbb) = ssh(:,:,Kbb) * tmask(:,:,1) 
     109 
     110      DO jn = 1, jpts 
     111         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb) * tmask(:,:,:) 
     112      END DO 
     113      uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)      
     114      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)  
     115 
     116      CALL lbc_lnk_multi( 'agrif_istate_oce', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
     117      CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
     118      CALL lbc_lnk( 'agrif_istate_oce', ssh(:,:,Kbb), 'T', 1.0_wp ) 
     119 
     120   END SUBROUTINE Agrif_istate_oce 
     121 
     122   SUBROUTINE Agrif_istate_ssh( Kbb, Kmm ) 
     123      !!---------------------------------------------------------------------- 
     124      !!                 *** ROUTINE agrif_istate_ssh *** 
     125      !! 
     126      !!                    set initial ssh from parent 
     127      !!---------------------------------------------------------------------- 
     128      ! 
     129      IMPLICIT NONE 
     130      ! 
     131      INTEGER, INTENT(in)  :: Kbb, Kmm  
     132      !!---------------------------------------------------------------------- 
     133      IF(lwp) WRITE(numout,*) ' ' 
     134      IF(lwp) WRITE(numout,*) 'Agrif_istate_ssh : interp child ssh from parent' 
     135      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
     136      IF(lwp) WRITE(numout,*) ' ' 
     137 
     138      IF ( ln_rstart ) &  
     139         & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 
     140 
     141      IF ( .NOT.Agrif_Parent(ln_1st_euler) ) &  
     142         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 
     143 
     144      Kmm_a = Kmm 
     145      ssh(:,:,Kmm) = 0._wp 
     146      l_ini_child = .TRUE. 
     147      Agrif_SpecialValue    = 0._wp 
     148      Agrif_UseSpecialValue = .TRUE. 
     149      CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 
     150      Agrif_UseSpecialValue = .FALSE. 
     151      l_ini_child = .FALSE. 
     152      CALL lbc_lnk( 'dom_vvl_rst', ssh(:,:,Kmm), 'T', 1._wp ) 
     153 
     154   END SUBROUTINE Agrif_istate_ssh 
     155 
    58156 
    59157   SUBROUTINE Agrif_tra 
     
    828926         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a) 
    829927      ELSE 
    830          hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
     928         IF( l_ini_child ) THEN 
     929            ssh(i1:i2,j1:j2,Kmm_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
     930         ELSE 
     931            hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
     932         ENDIF 
    831933      ENDIF 
    832934      ! 
     
    869971         END DO 
    870972 
    871         IF( l_vremap .OR. l_ini_child) THEN 
     973        IF( l_vremap .OR. l_ini_child ) THEN 
    872974         ! Extrapolate thicknesses in partial bottom cells: 
    873975         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     
    14621564      ! 
    14631565   END SUBROUTINE interpht0 
    1464  
    1465     
    1466    SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before) 
    1467        INTEGER :: i1, i2, j1, j2, k1, k2, m1, m2 
    1468        REAL(wp):: tabres(i1:i2,j1:j2,k1:k2,m1:m2) 
    1469        LOGICAL :: before 
    1470  
    1471        INTEGER :: jm 
    1472  
    1473        IF (before) THEN 
    1474          DO jm=1,jpts 
    1475              tabres(i1:i2,j1:j2,k1:k2,jm) = ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a) 
    1476          END DO 
    1477        ELSE 
    1478          DO jm=1,jpts 
    1479              ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a)=tabres(i1:i2,j1:j2,k1:k2,jm) 
    1480          END DO 
    1481        ENDIF 
    1482    END SUBROUTINE agrif_initts  
    1483  
    1484     
    1485    SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before ) 
    1486       !!---------------------------------------------------------------------- 
    1487       !!                  ***  ROUTINE interpsshn  *** 
    1488       !!----------------------------------------------------------------------   
    1489       INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
    1490       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    1491       LOGICAL                         , INTENT(in   ) ::   before 
    1492       ! 
    1493       !!----------------------------------------------------------------------   
    1494       ! 
    1495       IF( before) THEN 
    1496          ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kbb_a) 
    1497       ELSE 
    1498          ssh(i1:i2,j1:j2,Kbb_a) = ptab(i1:i2,j1:j2)*tmask(i1:i2,j1:j2,1) 
    1499       ENDIF 
    1500       ! 
    1501    END SUBROUTINE agrif_initssh 
    15021566    
    15031567#else 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90

    r13295 r13334  
    4040      !     
    4141   END SUBROUTINE Agrif_initvalues 
    42  
    43     
    44    SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 
    45       !!---------------------------------------------------------------------- 
    46       !!                 *** ROUTINE agrif_istate *** 
    47       !!---------------------------------------------------------------------- 
    48       USE domvvl 
    49       USE domain 
    50       USE par_oce 
    51       USE agrif_oce 
    52       USE agrif_oce_interp 
    53       USE oce 
    54       USE lib_mpp 
    55       USE lbclnk 
    56       ! 
    57       IMPLICIT NONE 
    58       ! 
    59       INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
    60       INTEGER :: jn 
    61       !!---------------------------------------------------------------------- 
    62       IF(lwp) WRITE(numout,*) ' ' 
    63       IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
    64       IF(lwp) WRITE(numout,*) ' ' 
    65  
    66       l_ini_child           = .TRUE. 
    67       Agrif_SpecialValue    = 0.0_wp 
    68       Agrif_UseSpecialValue = .TRUE. 
    69       uu(:,:,:,:) = 0.0_wp   ;   vv(:,:,:,:) = 0.0_wp   ;   ts(:,:,:,:,:) = 0.0_wp 
    70         
    71       Krhs_a = Kbb   ;   Kmm_a = Kbb 
    72  
    73       ! Brutal fix to pas 1x1 refinment.  
    74   !    IF(Agrif_Irhox() == 1) THEN 
    75   !       CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 
    76   !    ELSE 
    77       CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
    78  
    79   !    ENDIF 
    80 ! just for VORTEX because Parent velocities can actually be exactly zero 
    81 !      Agrif_UseSpecialValue = .FALSE. 
    82       Agrif_UseSpecialValue = ln_spc_dyn 
    83       use_sign_north = .TRUE. 
    84       sign_north = -1. 
    85       CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
    86       CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
    87       use_sign_north = .FALSE. 
    88  
    89       Agrif_UseSpecialValue = .FALSE. 
    90       l_ini_child           = .FALSE. 
    91  
    92       Krhs_a = Kaa   ;   Kmm_a = Kmm 
    93  
    94       DO jn = 1, jpts 
    95          ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
    96       END DO 
    97       uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)      
    98       vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)  
    99  
    100  
    101       CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
    102       CALL lbc_lnk(       'agrif_istate', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
    103  
    104    END SUBROUTINE Agrif_Istate 
    10542 
    10643    
     
    285222      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    286223 
    287       IF ( ln_init_chfrpar ) THEN  
    288          CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
    289          CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
    290          DO jk = 1, jpk 
    291                e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
    292                         &             / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    293                         &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    294          END DO 
    295       ENDIF 
    296224 
    297225      ! check if masks and bathymetries match 
     
    904832         &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 
    905833      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
     834      ! 
    906835      ! 
    907836   END SUBROUTINE agrif_nemo_init 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/domain.F90

    r13286 r13334  
    329329            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 
    330330            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot() 
     331            nn_date0 =  Agrif_Parent(ndastp) 
     332            nn_time0 =  Agrif_Parent(nn_time0) 
    331333      ENDIF 
    332334#endif 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/domvvl.F90

    r13295 r13334  
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2626   USE timing          ! Timing 
     27 
     28   USE agrif_oce       ! initial state interpolation 
     29   USE agrif_oce_interp  
    2730 
    2831   IMPLICIT NONE 
     
    803806      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    804807         !                                   ! =============== 
    805          IF( ln_rstart ) THEN                   !* Read the restart file 
    806             CALL rst_read_open                  !  open the restart file if necessary 
    807             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    808             ! 
    809             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    810             id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
    811             id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
    812             id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    813             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
    814             ! 
     808         IF( ln_rstart ) THEN 
     809                   !* Read the restart file 
     810#if defined key_agrif 
     811            IF ( (.NOT.Agrif_root()).AND.(ln_init_chfrpar) ) THEN 
     812               ! skip reading restart if initialized from parent: 
     813               id1 = -1 ; id2 = -1 ; id3 = -1 ; id4 = -1 ; id5 = -1 
     814            ELSE 
     815#endif 
     816               CALL rst_read_open                  !  open the restart file if necessary 
     817               CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     818               ! 
     819               id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
     820               id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
     821               id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
     822               id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
     823               id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     824#if defined key_agrif 
     825            ENDIF 
     826#endif 
    815827            !                             ! --------- ! 
    816828            !                             ! all cases ! 
     
    926938               ! is set up: 
    927939!               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    928 !               ! 
     940               ! 
    929941!               DO jk=1,jpk 
    930942!                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
    931 !                     &            / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 
     943!                     &                             / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) & 
     944!                     &             + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    932945!               END DO 
    933946!               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    934                 ssh(:,:,Kmm)=0._wp 
    935                 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 
    936                 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 
     947               ssh(:,:,Kmm)=0._wp 
     948               e3t(:,:,:,Kmm)=e3t_0(:,:,:) 
     949               e3t(:,:,:,Kbb)=e3t_0(:,:,:) 
    937950               ! 
    938951            END IF           ! end of ll_wd edits 
     
    944957            END IF 
    945958         ENDIF 
     959 
     960#if defined key_agrif 
     961         IF ( .NOT.Agrif_root().AND.(ln_init_chfrpar) ) THEN 
     962            ! Interpolate initial ssh from parent: 
     963            CALL Agrif_istate_ssh( Kbb, Kmm ) 
     964            ! 
     965            DO jk = 1, jpk 
     966               e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm)  ) & 
     967                 &                              / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     968                 &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     969            END DO 
     970            e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     971         ENDIF 
     972#endif 
    946973         ! 
    947974      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/istate.F90

    r13295 r13334  
    3434   USE lib_mpp         ! MPP library 
    3535   USE restart         ! restart 
    36 #if defined key_agrif 
    37    USE agrif_oce_interp 
    38    USE agrif_oce 
    39 #endif    
     36 
     37   USE agrif_oce       ! initial state interpolation 
     38   USE agrif_oce_interp    
    4039 
    4140   IMPLICIT NONE 
     
    8988#endif 
    9089 
     90      IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 
    9191#if defined key_agrif 
    92       IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 
    9392         numror = 0                           ! define numror = 0 -> no restart file to read 
    9493         ln_1st_euler = .true.                ! Set time-step indicator at nit000 (euler forward) 
    9594         CALL day_init  
    96          CALL agrif_istate( Kbb, Kmm, Kaa )   ! Interp from parent 
     95         CALL agrif_istate_oce( Kbb, Kmm, Kaa )   ! Interp from parent 
    9796         ! 
    98          ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
    99          ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
    100          uu   (:,:,:,Kmm)   = uu (:,:,:,Kbb) 
    101          vv   (:,:,:,Kmm)   = vv (:,:,:,Kbb) 
     97         ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
     98         ssh(:,:,Kmm)     = ssh(:,:,Kbb) 
     99         uu (:,:,:,Kmm)   = uu (:,:,:,Kbb) 
     100         vv (:,:,:,Kmm)   = vv (:,:,:,Kbb) 
    102101      ELSE 
    103102#endif 
    104       IF( ln_rstart ) THEN                    ! Restart from a file 
    105          !                                    ! ------------------- 
    106          CALL rst_read( Kbb, Kmm )            ! Read the restart file 
    107          CALL day_init                        ! model calendar (using both namelist and restart infos) 
    108          ! 
    109       ELSE                                    ! Start from rest 
    110          !                                    ! --------------- 
    111          numror = 0                           ! define numror = 0 -> no restart file to read 
    112          l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward) 
    113          CALL day_init                        ! model calendar (using both namelist and restart infos) 
    114          !                                    ! Initialization of ocean to zero 
    115          ! 
    116          IF( ln_tsd_init ) THEN                
    117             CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
     103         IF( ln_rstart ) THEN                    ! Restart from a file 
     104            !                                    ! ------------------- 
     105            CALL rst_read( Kbb, Kmm )            ! Read the restart file 
     106            CALL day_init                        ! model calendar (using both namelist and restart infos) 
    118107            ! 
    119             ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    120             uu  (:,:,:,Kbb) = 0._wp 
    121             vv  (:,:,:,Kbb) = 0._wp   
     108         ELSE                                    ! Start from rest 
     109            !                                    ! --------------- 
     110            numror = 0                           ! define numror = 0 -> no restart file to read 
     111            l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward) 
     112            CALL day_init                        ! model calendar (using both namelist and restart infos) 
     113            !                                    ! Initialization of ocean to zero 
    122114            ! 
    123             IF( ll_wd ) THEN 
    124                ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
     115            IF( ln_tsd_init ) THEN                
     116               CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    125117               ! 
    126                ! Apply minimum wetdepth criterion 
     118               ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
     119               uu  (:,:,:,Kbb) = 0._wp 
     120               vv  (:,:,:,Kbb) = 0._wp   
    127121               ! 
    128                DO_2D( 1, 1, 1, 1 ) 
    129                   IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    130                      ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    131                   ENDIF 
    132                END_2D 
    133             ENDIF  
    134              ! 
    135          ELSE                                 ! user defined initial T and S 
    136             DO jk = 1, jpk 
    137                zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
    138             END DO 
    139             CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
    140          ENDIF 
    141          ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    142          ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
    143          uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    144          vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     122               IF( ll_wd ) THEN 
     123                  ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
     124                  ! 
     125                  ! Apply minimum wetdepth criterion 
     126                  ! 
     127                  DO_2D( 1, 1, 1, 1 ) 
     128                     IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
     129                        ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
     130                     ENDIF 
     131                  END_2D 
     132               ENDIF  
     133               ! 
     134            ELSE                                 ! user defined initial T and S 
     135               DO jk = 1, jpk 
     136                  zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
     137               END DO 
     138               CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     139            ENDIF 
     140            ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     141            ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
     142            uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
     143            vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    145144 
    146145!!gm POTENTIAL BUG : 
     
    169168!!gm  
    170169         !  
    171       ENDIF  
    172 #if defined key_agrif 
     170         ENDIF  
     171 
    173172      ENDIF 
    174 #endif 
    175173      !  
    176174      ! Initialize "now" and "before" barotropic velocities: 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/tests/VORTEX/MY_SRC/domvvl.F90

    r13295 r13334  
    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) introduce ssh to h0 ratio 
    1112   !!---------------------------------------------------------------------- 
    1213 
    13    !!---------------------------------------------------------------------- 
    14    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    15    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
    16    !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
    17    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
    18    !!   dom_vvl_rst      : read/write restart file 
    19    !!   dom_vvl_ctl      : Check the vvl options 
    20    !!---------------------------------------------------------------------- 
    2114   USE oce             ! ocean dynamics and tracers 
    2215   USE phycst          ! physical constant 
     
    3326   USE timing          ! Timing 
    3427 
     28   USE agrif_oce ! initial state interpolation 
     29   USE agrif_oce_interp 
     30 
    3531   IMPLICIT NONE 
    3632   PRIVATE 
    37  
    38    PUBLIC  dom_vvl_init       ! called by domain.F90 
    39    PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
    40    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    41    PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    42    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    4333 
    4434   !                                                      !!* Namelist nam_vvl 
     
    6353   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6454 
     55#if defined key_qco 
     56   !!---------------------------------------------------------------------- 
     57   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     58   !!---------------------------------------------------------------------- 
     59#else 
     60   !!---------------------------------------------------------------------- 
     61   !!   Default key      Old management of time varying vertical coordinate 
     62   !!---------------------------------------------------------------------- 
     63    
     64   !!---------------------------------------------------------------------- 
     65   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     66   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
     67   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
     68   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
     69   !!   dom_vvl_rst      : read/write restart file 
     70   !!   dom_vvl_ctl      : Check the vvl options 
     71   !!---------------------------------------------------------------------- 
     72 
     73   PUBLIC  dom_vvl_init       ! called by domain.F90 
     74   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
     75   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
     76   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
     77   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
     78    
    6579   !! * Substitutions 
    6680#  include "do_loop_substitute.h90" 
     
    135149      ! 
    136150   END SUBROUTINE dom_vvl_init 
    137    ! 
     151 
     152 
    138153   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
    139154      !!---------------------------------------------------------------------- 
     
    261276            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    262277               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    263                   ii0 = 103   ;   ii1 = 111        
    264                   ij0 = 128   ;   ij1 = 135   ;    
     278                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     279                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    265280                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    266281                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
     
    450465            ELSE 
    451466               ijk_max = MAXLOC( ze3t(:,:,:) ) 
    452                ijk_max(1) = mig0_oldcmp(ijk_max(1)) 
    453                ijk_max(2) = mjg0_oldcmp(ijk_max(2)) 
     467               ijk_max(1) = ijk_max(1) + nimpp - 1 
     468               ijk_max(2) = ijk_max(2) + njmpp - 1 
    454469               ijk_min = MINLOC( ze3t(:,:,:) ) 
    455                ijk_min(1) = mig0_oldcmp(ijk_min(1)) 
    456                ijk_min(2) = mjg0_oldcmp(ijk_min(2)) 
     470               ijk_min(1) = ijk_min(1) + nimpp - 1 
     471               ijk_min(2) = ijk_min(2) + njmpp - 1 
    457472            ENDIF 
    458473            IF (lwp) THEN 
     
    792807         !                                   ! =============== 
    793808         IF( ln_rstart ) THEN                   !* Read the restart file 
    794             CALL rst_read_open                  !  open the restart file if necessary 
    795             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    796             ! 
    797             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    798             id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
    799             id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
    800             id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    801             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
    802             ! 
     809#if defined key_agrif 
     810            IF ( (.NOT.Agrif_root()).AND.(ln_init_chfrpar) ) THEN 
     811               ! skip reading restart if initialized from parent: 
     812               id1 = -1 ; id2 = -1 ; id3 = -1 ; id4 = -1 ; id5 = -1 
     813            ELSE 
     814#endif 
     815               CALL rst_read_open                  !  open the restart file if necessary 
     816               CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     817               ! 
     818               id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
     819               id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
     820               id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
     821               id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
     822               id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     823#if defined key_agrif 
     824            ENDIF 
     825#endif 
    803826            !                             ! --------- ! 
    804827            !                             ! all cases ! 
     
    837860               DO jk = 1, jpk 
    838861                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    839                       &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    840                       &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk)) 
     862                      &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     863                      &            + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk)) 
    841864               END DO 
    842865               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     
    911934            ELSE 
    912935               ! 
    913                ! usr_def_istate called here only to get ssh(Kbb) needed to initialize e3t(Kbb) and e3t(Kmm) 
    914                ! 
    915                CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )   
    916                ! 
    917                ! usr_def_istate will be called again in istate_init to initialize ts, ssh, u and v 
     936               ! Just to read set ssh in fact, called latter once vertical grid 
     937               ! is set up: 
     938               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    918939               ! 
    919940               DO jk=1,jpk 
    920941                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
    921                     &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)  & 
    922                     &            + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )   ! make sure e3t(:,:,:,Kbb) != 0 on land points 
     942                     &                             / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) & 
     943                     &             + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    923944               END DO 
    924945               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    925                ssh(:,:,Kmm) = ssh(:,:,Kbb)                                     ! needed later for gde3w 
     946!               ssh(:,:,Kmm)=0._wp 
     947!               e3t(:,:,:,Kmm)=e3t_0(:,:,:) 
     948!               e3t(:,:,:,Kbb)=e3t_0(:,:,:) 
    926949               ! 
    927950            END IF           ! end of ll_wd edits 
     
    933956            END IF 
    934957         ENDIF 
     958 
     959#if defined key_agrif 
     960         IF ( .NOT.Agrif_root().AND.(ln_init_chfrpar) ) THEN 
     961            ! Interpolate initial ssh from parent: 
     962            CALL Agrif_istate_ssh( Kbb, Kmm ) 
     963            ! 
     964            DO jk = 1, jpk 
     965               e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm)  ) & 
     966                 &                              / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     967                 &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     968            END DO 
     969            e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     970         ENDIF 
     971#endif 
    935972         ! 
    936973      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
     
    10301067   END SUBROUTINE dom_vvl_ctl 
    10311068 
     1069#endif 
     1070 
    10321071   !!====================================================================== 
    10331072END MODULE domvvl 
Note: See TracChangeset for help on using the changeset viewer.