- Timestamp:
- 2019-12-05T18:41:39+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/UKMO_MERGE_2019/tests/ISOMIP+/MY_SRC/istate.F90
r11889 r12077 50 50 CONTAINS 51 51 52 SUBROUTINE istate_init 52 SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 53 53 !!---------------------------------------------------------------------- 54 54 !! *** ROUTINE istate_init *** … … 56 56 !! ** Purpose : Initialization of the dynamics and tracer fields. 57 57 !!---------------------------------------------------------------------- 58 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices 59 ! 58 60 INTEGER :: ji, jj, jk ! dummy loop indices 59 61 !!gm see comment further down … … 75 77 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 76 78 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 77 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 78 80 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 79 81 #if defined key_agrif 80 u a (:,:,:) = 0._wp ! used in agrif_oce_sponge at initialization81 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 82 84 #endif 83 85 84 86 IF( ln_rstart ) THEN ! Restart from a file 85 87 ! ! ------------------- 86 CALL rst_read 88 CALL rst_read( Kbb, Kmm ) ! Read the restart file 87 89 CALL day_init ! model calendar (using both namelist and restart infos) 88 90 ! … … 95 97 ! 96 98 IF( ln_tsd_init ) THEN 97 CALL dta_tsd( nit000, 'ini', ts b) ! read 3D T and S data at nit00099 CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 98 100 ! 99 ssh b(:,:) = 0._wp ! set the ocean at rest101 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 100 102 IF( ll_wd ) THEN 101 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 102 104 ! 103 105 ! Apply minimum wetdepth criterion … … 105 107 DO jj = 1,jpj 106 108 DO ji = 1,jpi 107 IF( ht_0(ji,jj) + ssh b(ji,jj) < rn_wdmin1 ) THEN108 ssh b(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )109 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 110 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 109 111 ENDIF 110 112 END DO 111 113 END DO 112 114 ENDIF 113 u b (:,:,:) = 0._wp114 v b (:,:,:) = 0._wp115 uu (:,:,:,Kbb) = 0._wp 116 vv (:,:,:,Kbb) = 0._wp 115 117 ! 116 118 ELSE ! user defined initial T and S 117 CALL usr_def_istate( gdept _b, tmask, tsb, ub, vb, sshb)119 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 118 120 ENDIF 119 ts n (:,:,:,:) = tsb (:,:,:,:) ! set now values from to before ones120 ssh n (:,:) = sshb(:,:)121 u n (:,:,:) = ub (:,:,:)122 v n (:,:,:) = vb (:,:,:)123 hdiv n(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level124 CALL div_hor( 0 ) ! compute interior hdivnvalue125 !!gm hdiv n(:,:,:) = 0._wp121 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 122 ssh (:,:,Kmm) = ssh(:,:,Kbb) 123 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 124 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 125 hdiv(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level 126 CALL div_hor( 0, Kbb, Kmm ) ! compute interior hdiv value 127 !!gm hdiv(:,:,:) = 0._wp 126 128 127 129 !!gm POTENTIAL BUG : 128 !!gm ISSUE : if ssh b/= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed130 !!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed 129 131 !! as well as gdept and gdepw.... !!!!! 130 132 !! ===>>>> probably a call to domvvl initialisation here.... … … 136 138 ! ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 137 139 ! CALL dta_uvd( nit000, zuvd ) 138 ! u b(:,:,:) = zuvd(:,:,:,1) ; un(:,:,:) = ub(:,:,:)139 ! v b(:,:,:) = zuvd(:,:,:,2) ; vn(:,:,:) = vb(:,:,:)140 ! uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 141 ! vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 140 142 ! DEALLOCATE( zuvd ) 141 143 ! ENDIF 142 144 ! 143 145 !!gm This is to be changed !!!! 144 ! ! - ML - ssh n could be modified by istate_eel, so that initialization of e3t_bis done here146 ! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 145 147 ! IF( .NOT.ln_linssh ) THEN 146 148 ! DO jk = 1, jpk 147 ! e3t _b(:,:,jk) = e3t_n(:,:,jk)149 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 148 150 ! END DO 149 151 ! ENDIF … … 155 157 ! Do it whatever the free surface method, these arrays being eventually used 156 158 ! 157 u n_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp158 u b_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp159 uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp 160 uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp 159 161 ! 160 !!gm the use of umsak & vmask is not necessary below as u n, vn, ub, vbare always masked162 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 161 163 DO jk = 1, jpkm1 162 164 DO jj = 1, jpj 163 165 DO ji = 1, jpi 164 u n_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)165 v n_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)166 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 167 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 166 168 ! 167 u b_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)168 v b_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)169 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 170 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 169 171 END DO 170 172 END DO 171 173 END DO 172 174 ! 173 u n_b(:,:) = un_b(:,:) * r1_hu_n(:,:)174 v n_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)175 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 176 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 175 177 ! 176 u b_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)177 v b_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)178 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 179 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 178 180 ! 179 181 END SUBROUTINE istate_init
Note: See TracChangeset
for help on using the changeset viewer.
