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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DOM/istate.F90 – NEMO

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

Ticket #2195:update to trunk 13461

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

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DOM/istate.F90

    r10499 r13463  
    2424   USE dom_oce        ! ocean space and time domain  
    2525   USE daymod         ! calendar 
    26    USE divhor         ! horizontal divergence            (div_hor routine) 
    2726   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
    2827   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    2928   USE domvvl          ! varying vertical mesh 
    30    USE iscplrst        ! ice sheet coupling 
    3129   USE wet_dry         ! wetting and drying (needed for wad_istate) 
    3230   USE usrdef_istate   ! User defined initial state 
     
    3634   USE lib_mpp         ! MPP library 
    3735   USE restart         ! restart 
     36#if defined key_agrif 
     37   USE agrif_oce_interp 
     38   USE agrif_oce 
     39#endif    
    3840 
    3941   IMPLICIT NONE 
     
    4345 
    4446   !! * Substitutions 
    45 #  include "vectopt_loop_substitute.h90" 
     47#  include "do_loop_substitute.h90" 
     48#  include "domzgr_substitute.h90" 
    4649   !!---------------------------------------------------------------------- 
    4750   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5154CONTAINS 
    5255 
    53    SUBROUTINE istate_init 
     56   SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 
    5457      !!---------------------------------------------------------------------- 
    5558      !!                   ***  ROUTINE istate_init  *** 
     
    5760      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    5861      !!---------------------------------------------------------------------- 
     62      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices 
     63      ! 
    5964      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     65      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table  !!st patch to use gdept subtitute 
    6066!!gm see comment further down 
    6167      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     
    6975!!gm  Why not include in the first call of dta_tsd ?   
    7076!!gm  probably associated with the use of internal damping... 
    71                      CALL dta_tsd_init        ! Initialisation of T & S input data 
     77       CALL dta_tsd_init        ! Initialisation of T & S input data 
    7278!!gm to be moved in usrdef of C1D case 
    7379!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     
    7682      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    7783      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    78       tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk 
     84      ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
    7985      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    8086#if defined key_agrif 
    81       ua   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization 
    82       va   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization     
     87      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization 
     88      vv   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization     
    8389#endif 
    8490 
     91#if defined key_agrif 
     92      IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 
     93         numror = 0                           ! define numror = 0 -> no restart file to read 
     94         ln_1st_euler = .true.                ! Set time-step indicator at nit000 (euler forward) 
     95         CALL day_init  
     96         CALL agrif_istate( Kbb, Kmm, Kaa )   ! Interp from parent 
     97         ! 
     98         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
     99         ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
     100         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
     101         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     102      ELSE 
     103#endif 
    85104      IF( ln_rstart ) THEN                    ! Restart from a file 
    86105         !                                    ! ------------------- 
    87          CALL rst_read                        ! Read the restart file 
    88          IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry 
     106         CALL rst_read( Kbb, Kmm )            ! Read the restart file 
    89107         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    90108         ! 
     
    92110         !                                    ! --------------- 
    93111         numror = 0                           ! define numror = 0 -> no restart file to read 
    94          neuler = 0                           ! Set time-step indicator at nit000 (euler forward) 
     112         l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward) 
    95113         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    96114         !                                    ! Initialization of ocean to zero 
    97115         ! 
    98116         IF( ln_tsd_init ) THEN                
    99             CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000 
     117            CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    100118            ! 
    101             sshb(:,:)   = 0._wp               ! set the ocean at rest 
     119            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
     120            uu  (:,:,:,Kbb) = 0._wp 
     121            vv  (:,:,:,Kbb) = 0._wp   
     122            ! 
    102123            IF( ll_wd ) THEN 
    103                sshb(:,:) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
     124               ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    104125               ! 
    105126               ! Apply minimum wetdepth criterion 
    106127               ! 
    107                DO jj = 1,jpj 
    108                   DO ji = 1,jpi 
    109                      IF( ht_0(ji,jj) + sshb(ji,jj)  < rn_wdmin1 ) THEN 
    110                         sshb(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    111                      ENDIF 
    112                   END DO 
    113                END DO  
     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 
    114133            ENDIF  
    115             ub  (:,:,:) = 0._wp 
    116             vb  (:,:,:) = 0._wp   
    117             ! 
     134             ! 
    118135         ELSE                                 ! user defined initial T and S 
    119             CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )          
     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)  )          
    120140         ENDIF 
    121          tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones 
    122          sshn (:,:)     = sshb(:,:)    
    123          un   (:,:,:)   = ub  (:,:,:) 
    124          vn   (:,:,:)   = vb  (:,:,:) 
    125          hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    126          CALL div_hor( 0 )                    ! compute interior hdivn value   
    127 !!gm                                    hdivn(:,:,:) = 0._wp 
     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) 
    128145 
    129146!!gm POTENTIAL BUG : 
    130 !!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    131 !!             as well as gdept and gdepw....   !!!!!  
     147!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
     148!!             as well as gdept_ and gdepw_....   !!!!!  
    132149!!      ===>>>>   probably a call to domvvl initialisation here.... 
    133150 
     
    138155!            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    139156!            CALL dta_uvd( nit000, zuvd ) 
    140 !            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    141 !            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
     157!            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
     158!            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
    142159!            DEALLOCATE( zuvd ) 
    143160!         ENDIF 
    144161         ! 
    145162!!gm This is to be changed !!!! 
    146 !         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
     163!         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 
    147164!         IF( .NOT.ln_linssh ) THEN 
    148165!            DO jk = 1, jpk 
    149 !               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     166!               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    150167!            END DO 
    151168!         ENDIF 
     
    153170         !  
    154171      ENDIF  
     172#if defined key_agrif 
     173      ENDIF 
     174#endif 
    155175      !  
    156176      ! Initialize "now" and "before" barotropic velocities: 
    157177      ! Do it whatever the free surface method, these arrays being eventually used 
    158178      ! 
    159       un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
    160       ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    161       ! 
    162 !!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 
    163       DO jk = 1, jpkm1 
    164          DO jj = 1, jpj 
    165             DO ji = 1, jpi 
    166                un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    167                vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    168                ! 
    169                ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    170                vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    171             END DO 
    172          END DO 
    173       END DO 
    174       ! 
    175       un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 
    176       vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 
    177       ! 
    178       ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    179       vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     179      uu_b(:,:,Kmm) = 0._wp   ;   vv_b(:,:,Kmm) = 0._wp 
     180      uu_b(:,:,Kbb) = 0._wp   ;   vv_b(:,:,Kbb) = 0._wp 
     181      ! 
     182!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
     183      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     184         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     185         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     186         ! 
     187         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
     188         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
     189      END_3D 
     190      ! 
     191      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
     192      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
     193      ! 
     194      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 
     195      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 
    180196      ! 
    181197   END SUBROUTINE istate_init 
Note: See TracChangeset for help on using the changeset viewer.