- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- 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 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DOM/istate.F90
r10499 r13463 24 24 USE dom_oce ! ocean space and time domain 25 25 USE daymod ! calendar 26 USE divhor ! horizontal divergence (div_hor routine)27 26 USE dtatsd ! data temperature and salinity (dta_tsd routine) 28 27 USE dtauvd ! data: U & V current (dta_uvd routine) 29 28 USE domvvl ! varying vertical mesh 30 USE iscplrst ! ice sheet coupling31 29 USE wet_dry ! wetting and drying (needed for wad_istate) 32 30 USE usrdef_istate ! User defined initial state … … 36 34 USE lib_mpp ! MPP library 37 35 USE restart ! restart 36 #if defined key_agrif 37 USE agrif_oce_interp 38 USE agrif_oce 39 #endif 38 40 39 41 IMPLICIT NONE … … 43 45 44 46 !! * Substitutions 45 # include "vectopt_loop_substitute.h90" 47 # include "do_loop_substitute.h90" 48 # include "domzgr_substitute.h90" 46 49 !!---------------------------------------------------------------------- 47 50 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 51 54 CONTAINS 52 55 53 SUBROUTINE istate_init 56 SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 54 57 !!---------------------------------------------------------------------- 55 58 !! *** ROUTINE istate_init *** … … 57 60 !! ** Purpose : Initialization of the dynamics and tracer fields. 58 61 !!---------------------------------------------------------------------- 62 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices 63 ! 59 64 INTEGER :: ji, jj, jk ! dummy loop indices 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! 3D table !!st patch to use gdept subtitute 60 66 !!gm see comment further down 61 67 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace … … 69 75 !!gm Why not include in the first call of dta_tsd ? 70 76 !!gm probably associated with the use of internal damping... 71 77 CALL dta_tsd_init ! Initialisation of T & S input data 72 78 !!gm to be moved in usrdef of C1D case 73 79 ! IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data … … 76 82 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 77 83 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 78 ts a (:,:,:,:) = 0._wp ! set one for all to 0 at level jpk84 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 79 85 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 80 86 #if defined key_agrif 81 u a (:,:,:) = 0._wp ! used in agrif_oce_sponge at initialization82 v a (:,:,:) = 0._wp ! used in agrif_oce_sponge at initialization87 uu (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization 88 vv (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization 83 89 #endif 84 90 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 85 104 IF( ln_rstart ) THEN ! Restart from a file 86 105 ! ! ------------------- 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 89 107 CALL day_init ! model calendar (using both namelist and restart infos) 90 108 ! … … 92 110 ! ! --------------- 93 111 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) 95 113 CALL day_init ! model calendar (using both namelist and restart infos) 96 114 ! ! Initialization of ocean to zero 97 115 ! 98 116 IF( ln_tsd_init ) THEN 99 CALL dta_tsd( nit000, ts b) ! read 3D T and S data at nit000117 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 100 118 ! 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 ! 102 123 IF( ll_wd ) THEN 103 ssh b(:,:) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD124 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 104 125 ! 105 126 ! Apply minimum wetdepth criterion 106 127 ! 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 114 133 ENDIF 115 ub (:,:,:) = 0._wp 116 vb (:,:,:) = 0._wp 117 ! 134 ! 118 135 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) ) 120 140 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) 128 145 129 146 !!gm POTENTIAL BUG : 130 !!gm ISSUE : if ssh b/= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed131 !! 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_.... !!!!! 132 149 !! ===>>>> probably a call to domvvl initialisation here.... 133 150 … … 138 155 ! ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 139 156 ! CALL dta_uvd( nit000, zuvd ) 140 ! u b(:,:,:) = zuvd(:,:,:,1) ; un(:,:,:) = ub(:,:,:)141 ! v b(:,:,:) = zuvd(:,:,:,2) ; vn(:,:,:) = vb(:,:,:)157 ! uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 158 ! vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 142 159 ! DEALLOCATE( zuvd ) 143 160 ! ENDIF 144 161 ! 145 162 !!gm This is to be changed !!!! 146 ! ! - ML - ssh n could be modified by istate_eel, so that initialization of e3t_bis done here163 ! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 147 164 ! IF( .NOT.ln_linssh ) THEN 148 165 ! DO jk = 1, jpk 149 ! e3t _b(:,:,jk) = e3t_n(:,:,jk)166 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 150 167 ! END DO 151 168 ! ENDIF … … 153 170 ! 154 171 ENDIF 172 #if defined key_agrif 173 ENDIF 174 #endif 155 175 ! 156 176 ! Initialize "now" and "before" barotropic velocities: 157 177 ! Do it whatever the free surface method, these arrays being eventually used 158 178 ! 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) 180 196 ! 181 197 END SUBROUTINE istate_init
Note: See TracChangeset
for help on using the changeset viewer.