- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/istate.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DOM/istate.F90
r10499 r12928 28 28 USE dtauvd ! data: U & V current (dta_uvd routine) 29 29 USE domvvl ! varying vertical mesh 30 USE iscplrst ! ice sheet coupling31 30 USE wet_dry ! wetting and drying (needed for wad_istate) 32 31 USE usrdef_istate ! User defined initial state … … 43 42 44 43 !! * Substitutions 45 # include " vectopt_loop_substitute.h90"44 # include "do_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- 47 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 51 50 CONTAINS 52 51 53 SUBROUTINE istate_init 52 SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 54 53 !!---------------------------------------------------------------------- 55 54 !! *** ROUTINE istate_init *** … … 57 56 !! ** Purpose : Initialization of the dynamics and tracer fields. 58 57 !!---------------------------------------------------------------------- 58 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices 59 ! 59 60 INTEGER :: ji, jj, jk ! dummy loop indices 60 61 !!gm see comment further down … … 76 77 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 77 78 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 jpk79 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 79 80 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 80 81 #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 initialization82 uu (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization 83 vv (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization 83 84 #endif 84 85 85 86 IF( ln_rstart ) THEN ! Restart from a file 86 87 ! ! ------------------- 87 CALL rst_read ! Read the restart file 88 IF (ln_iscpl) CALL iscpl_stp ! extrapolate restart to wet and dry 88 CALL rst_read( Kbb, Kmm ) ! Read the restart file 89 89 CALL day_init ! model calendar (using both namelist and restart infos) 90 90 ! … … 92 92 ! ! --------------- 93 93 numror = 0 ! define numror = 0 -> no restart file to read 94 neuler = 0! Set time-step indicator at nit000 (euler forward)94 l_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 95 95 CALL day_init ! model calendar (using both namelist and restart infos) 96 96 ! ! Initialization of ocean to zero 97 97 ! 98 98 IF( ln_tsd_init ) THEN 99 CALL dta_tsd( nit000, ts b) ! read 3D T and S data at nit00099 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 100 100 ! 101 ssh b(:,:) = 0._wp ! set the ocean at rest101 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 102 102 IF( ll_wd ) THEN 103 ssh b(:,:) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD103 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 104 104 ! 105 105 ! Apply minimum wetdepth criterion 106 106 ! 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 107 DO_2D_11_11 108 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 109 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 110 ENDIF 111 END_2D 114 112 ENDIF 115 u b (:,:,:) = 0._wp116 v b (:,:,:) = 0._wp113 uu (:,:,:,Kbb) = 0._wp 114 vv (:,:,:,Kbb) = 0._wp 117 115 ! 118 116 ELSE ! user defined initial T and S 119 CALL usr_def_istate( gdept _b, tmask, tsb, ub, vb, sshb)117 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 120 118 ENDIF 121 ts n (:,:,:,:) = tsb (:,:,:,:) ! set now values from to before ones122 ssh n (:,:) = sshb(:,:)123 u n (:,:,:) = ub (:,:,:)124 v n (:,:,:) = vb (:,:,:)125 hdiv n(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level126 CALL div_hor( 0 ) ! compute interior hdivnvalue127 !!gm hdiv n(:,:,:) = 0._wp119 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 120 ssh (:,:,Kmm) = ssh(:,:,Kbb) 121 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 122 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 123 hdiv(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level 124 CALL div_hor( 0, Kbb, Kmm ) ! compute interior hdiv value 125 !!gm hdiv(:,:,:) = 0._wp 128 126 129 127 !!gm POTENTIAL BUG : 130 !!gm ISSUE : if ssh b/= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed128 !!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed 131 129 !! as well as gdept and gdepw.... !!!!! 132 130 !! ===>>>> probably a call to domvvl initialisation here.... … … 138 136 ! ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 139 137 ! CALL dta_uvd( nit000, zuvd ) 140 ! u b(:,:,:) = zuvd(:,:,:,1) ; un(:,:,:) = ub(:,:,:)141 ! v b(:,:,:) = zuvd(:,:,:,2) ; vn(:,:,:) = vb(:,:,:)138 ! uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 139 ! vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 142 140 ! DEALLOCATE( zuvd ) 143 141 ! ENDIF 144 142 ! 145 143 !!gm This is to be changed !!!! 146 ! ! - ML - ssh n could be modified by istate_eel, so that initialization of e3t_bis done here144 ! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 147 145 ! IF( .NOT.ln_linssh ) THEN 148 146 ! DO jk = 1, jpk 149 ! e3t _b(:,:,jk) = e3t_n(:,:,jk)147 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 150 148 ! END DO 151 149 ! ENDIF … … 157 155 ! Do it whatever the free surface method, these arrays being eventually used 158 156 ! 159 u n_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp160 u b_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp157 uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp 158 uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp 161 159 ! 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 160 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 161 DO_3D_11_11( 1, jpkm1 ) 162 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 163 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 164 ! 165 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 166 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 167 END_3D 174 168 ! 175 u n_b(:,:) = un_b(:,:) * r1_hu_n(:,:)176 v n_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)169 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 170 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 177 171 ! 178 u b_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)179 v b_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)172 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 173 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 180 174 ! 181 175 END SUBROUTINE istate_init
Note: See TracChangeset
for help on using the changeset viewer.
