- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/istate.F90
r10499 r11949 51 51 CONTAINS 52 52 53 SUBROUTINE istate_init 53 SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE istate_init *** … … 57 57 !! ** Purpose : Initialization of the dynamics and tracer fields. 58 58 !!---------------------------------------------------------------------- 59 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices 60 ! 59 61 INTEGER :: ji, jj, jk ! dummy loop indices 60 62 !!gm see comment further down … … 76 78 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 77 79 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 jpk80 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 79 81 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 80 82 #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 initialization83 uu (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization 84 vv (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization 83 85 #endif 84 86 85 87 IF( ln_rstart ) THEN ! Restart from a file 86 88 ! ! ------------------- 87 CALL rst_read 88 IF (ln_iscpl) CALL iscpl_stp ! extrapolate restart to wet and dry89 CALL rst_read( Kbb, Kmm ) ! Read the restart file 90 IF (ln_iscpl) CALL iscpl_stp( Kbb, Kmm ) ! extrapolate restart to wet and dry 89 91 CALL day_init ! model calendar (using both namelist and restart infos) 90 92 ! … … 97 99 ! 98 100 IF( ln_tsd_init ) THEN 99 CALL dta_tsd( nit000, ts b) ! read 3D T and S data at nit000101 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 100 102 ! 101 ssh b(:,:) = 0._wp ! set the ocean at rest103 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 102 104 IF( ll_wd ) THEN 103 ssh b(:,:) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD105 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 104 106 ! 105 107 ! Apply minimum wetdepth criterion … … 107 109 DO jj = 1,jpj 108 110 DO ji = 1,jpi 109 IF( ht_0(ji,jj) + ssh b(ji,jj) < rn_wdmin1 ) THEN110 ssh b(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )111 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 112 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 111 113 ENDIF 112 114 END DO 113 115 END DO 114 116 ENDIF 115 u b (:,:,:) = 0._wp116 v b (:,:,:) = 0._wp117 uu (:,:,:,Kbb) = 0._wp 118 vv (:,:,:,Kbb) = 0._wp 117 119 ! 118 120 ELSE ! user defined initial T and S 119 CALL usr_def_istate( gdept _b, tmask, tsb, ub, vb, sshb)121 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 120 122 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._wp123 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 124 ssh (:,:,Kmm) = ssh(:,:,Kbb) 125 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 126 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 127 hdiv(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level 128 CALL div_hor( 0, Kbb, Kmm ) ! compute interior hdiv value 129 !!gm hdiv(:,:,:) = 0._wp 128 130 129 131 !!gm POTENTIAL BUG : 130 !!gm ISSUE : if ssh b/= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed132 !!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed 131 133 !! as well as gdept and gdepw.... !!!!! 132 134 !! ===>>>> probably a call to domvvl initialisation here.... … … 138 140 ! ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 139 141 ! CALL dta_uvd( nit000, zuvd ) 140 ! u b(:,:,:) = zuvd(:,:,:,1) ; un(:,:,:) = ub(:,:,:)141 ! v b(:,:,:) = zuvd(:,:,:,2) ; vn(:,:,:) = vb(:,:,:)142 ! uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 143 ! vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 142 144 ! DEALLOCATE( zuvd ) 143 145 ! ENDIF 144 146 ! 145 147 !!gm This is to be changed !!!! 146 ! ! - ML - ssh n could be modified by istate_eel, so that initialization of e3t_bis done here148 ! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 147 149 ! IF( .NOT.ln_linssh ) THEN 148 150 ! DO jk = 1, jpk 149 ! e3t _b(:,:,jk) = e3t_n(:,:,jk)151 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 150 152 ! END DO 151 153 ! ENDIF … … 157 159 ! Do it whatever the free surface method, these arrays being eventually used 158 160 ! 159 u n_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp160 u b_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp161 uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp 162 uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp 161 163 ! 162 !!gm the use of umsak & vmask is not necessary below as u n, vn, ub, vbare always masked164 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 163 165 DO jk = 1, jpkm1 164 166 DO jj = 1, jpj 165 167 DO ji = 1, jpi 166 u n_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)167 v n_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)168 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 169 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 168 170 ! 169 u b_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)170 v b_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)171 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 172 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 171 173 END DO 172 174 END DO 173 175 END DO 174 176 ! 175 u n_b(:,:) = un_b(:,:) * r1_hu_n(:,:)176 v n_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)177 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 178 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 177 179 ! 178 u b_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)179 v b_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)180 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 181 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 180 182 ! 181 183 END SUBROUTINE istate_init
Note: See TracChangeset
for help on using the changeset viewer.