Changeset 2452
- Timestamp:
- 2010-12-05T12:53:44+01:00 (14 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r2364 r2452 16 16 !! rst_read : read the ocean restart file 17 17 !!---------------------------------------------------------------------- 18 USE oce ! ocean dynamics and tracers 18 19 USE dom_oce ! ocean space and time domain 19 USE oce ! ocean dynamics and tracers20 20 USE phycst ! physical constants 21 21 USE in_out_manager ! I/O manager 22 22 USE iom ! I/O module 23 USE zpshde ! partial step: hor. derivative (zps_hde routine)24 23 USE eosbn2 ! equation of state (eos bn2 routine) 25 USE zdfddm ! double diffusion mixing26 USE zdfmxl ! mixed layer depth27 24 USE trdmld_oce ! ocean active mixed layer tracers trends variables 28 25 USE domvvl ! variable volume 29 26 USE traswp ! swap from 4D T-S to 3D T & S and vice versa 30 #if defined key_zdfgls31 USE zdfbfr, ONLY : wbotu, wbotv ! bottom stresses32 USE zdf_oce33 #endif34 27 35 28 IMPLICIT NONE … … 49 42 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 50 43 !! $Id$ 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 52 !!---------------------------------------------------------------------- 53 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 !!---------------------------------------------------------------------- 54 46 CONTAINS 55 47 … … 100 92 ENDIF 101 93 ENDIF 102 94 ! 103 95 CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 104 96 lrst_oce = .TRUE. … … 120 112 !!---------------------------------------------------------------------- 121 113 122 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics time step 123 CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) ) ! surface tracer time step 124 125 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) ! before fields 126 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb ) 127 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tb ) 128 CALL iom_rstput( kt, nitrst, numrow, 'sb' , sb ) 129 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb ) 130 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 131 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 132 IF( lk_vvl ) & 133 CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 134 ! 135 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields 136 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn ) 137 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tn ) 138 CALL iom_rstput( kt, nitrst, numrow, 'sn' , sn ) 139 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn ) 140 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn ) 141 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 142 143 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 114 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics time step 115 CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) ) ! surface tracer time step 116 117 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) ! before fields 118 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb ) 119 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tb ) 120 CALL iom_rstput( kt, nitrst, numrow, 'sb' , sb ) 121 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb ) 122 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 123 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 124 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 125 ! 126 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields 127 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn ) 128 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tn ) 129 CALL iom_rstput( kt, nitrst, numrow, 'sn' , sn ) 130 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn ) 131 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn ) 132 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 133 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 144 134 #if defined key_zdfkpp 145 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd)135 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 146 136 #endif 147 148 #if defined key_zdfgls149 ! Save bottom stresses150 CALL iom_rstput( kt, nitrst, numrow, 'wbotu' , wbotu )151 CALL iom_rstput( kt, nitrst, numrow, 'wbotv' , wbotv )152 #endif153 154 137 IF( kt == nitrst ) THEN 155 138 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 201 184 ENDIF 202 185 ! 203 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields 204 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb ) 205 CALL iom_get( numror, jpdom_autoglo, 'tb' , tb ) 206 CALL iom_get( numror, jpdom_autoglo, 'sb' , sb ) 207 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb ) 208 CALL iom_get( numror, jpdom_autoglo, 'hdivb', hdivb ) 209 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 210 IF( lk_vvl ) & 211 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 212 ! 213 CALL iom_get( numror, jpdom_autoglo, 'un' , un ) ! now fields 214 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn ) 215 CALL iom_get( numror, jpdom_autoglo, 'tn' , tn ) 216 CALL iom_get( numror, jpdom_autoglo, 'sn' , sn ) 217 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn ) 218 CALL iom_get( numror, jpdom_autoglo, 'hdivn', hdivn ) 219 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 220 221 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 186 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields 187 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb ) 188 CALL iom_get( numror, jpdom_autoglo, 'tb' , tb ) 189 CALL iom_get( numror, jpdom_autoglo, 'sb' , sb ) 190 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb ) 191 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 192 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 193 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 194 ! 195 CALL iom_get( numror, jpdom_autoglo, 'un' , un ) ! now fields 196 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn ) 197 CALL iom_get( numror, jpdom_autoglo, 'tn' , tn ) 198 CALL iom_get( numror, jpdom_autoglo, 'sn' , sn ) 199 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn ) 200 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn ) 201 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 202 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 222 203 #if defined key_zdfkpp 223 204 IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN 224 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd )! now in situ density anomaly205 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly 225 206 ELSE 226 CALL tra_swap227 CALL eos( tsn, rhd ) ! compute rhd207 CALL tra_swap 208 CALL eos( tsn, rhd ) ! compute rhd 228 209 ENDIF 229 210 #endif 230 211 ! 231 212 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 232 213 tb (:,:,:) = tn (:,:,:) ! all before fields set to now values … … 240 221 DO jk = 1, jpk 241 222 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 242 END DO223 END DO 243 224 ENDIF 244 225 ENDIF -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r2450 r2452 1168 1168 1169 1169 SUBROUTINE gls_rst( kt, cdrw ) 1170 !!--------------------------------------------------------------------- 1171 !! *** ROUTINE ts_rst *** 1172 !! 1173 !! ** Purpose : Read or write TKE file (en) in restart file 1174 !! 1175 !! ** Method : use of IOM library 1176 !! if the restart does not contain TKE, en is either 1177 !! set to rn_emin or recomputed (nn_igls/=0) 1178 !!---------------------------------------------------------------------- 1179 INTEGER , INTENT(in) :: kt ! ocean time-step 1180 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 1181 ! 1182 INTEGER :: jit, jk ! dummy loop indices 1183 INTEGER :: id1, id2, id3, id4, id5, id6, id7, id8 1184 INTEGER :: ji, jj, ikbu, ikbv, ikbum1, ikbvm1 1185 REAL(wp):: cbx, cby 1186 !!---------------------------------------------------------------------- 1187 ! 1188 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 1189 ! ! --------------- 1190 IF( ln_rstart ) THEN !* Read the restart file 1191 id1 = iom_varid( numror, 'en' , ldstop = .FALSE. ) 1192 id2 = iom_varid( numror, 'avt' , ldstop = .FALSE. ) 1193 id3 = iom_varid( numror, 'avm' , ldstop = .FALSE. ) 1194 id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. ) 1195 id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. ) 1196 id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. ) 1197 id7 = iom_varid( numror, 'wbotu', ldstop = .FALSE. ) 1198 id8 = iom_varid( numror, 'wbotv', ldstop = .FALSE. ) 1199 ! 1200 IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN ! all required arrays exist 1201 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1202 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 1203 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) 1204 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu ) 1205 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 1206 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln ) 1207 CALL iom_get( numror, jpdom_autoglo, 'wbotu' , wbotu ) 1208 CALL iom_get( numror, jpdom_autoglo, 'wbotv' , wbotv ) 1209 ELSE 1210 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' 1211 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1212 en (:,:,:) = rn_emin 1213 mxln(:,:,:) = 0.001 1214 ! Initialize bottom stresses 1215 DO jj = 2, jpjm1 1216 DO ji = fs_2, fs_jpim1 ! vector opt. 1217 ikbu = mbku(ji,jj) + 1 ! k bottom level of uw-point 1218 ikbum1 = mbku(ji,jj) ! k-1 bottom level of u -point, but >=1 1219 ikbv = mbkv(ji,jj) + 1 1220 ikbvm1 = mbkv(ji,jj) 1221 cbx = avmu(ji,jj,ikbu) / fse3uw(ji,jj,ikbu) 1222 cby = avmv(ji,jj,ikbv) / fse3vw(ji,jj,ikbv) 1223 wbotu(ji,jj) = -cbx * un(ji,jj,ikbum1) * umask(ji,jj,1) 1224 wbotv(ji,jj) = -cby * vn(ji,jj,ikbvm1) * vmask(ji,jj,1) 1225 END DO 1226 END DO 1227 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_gls( jit ) ; END DO 1228 ENDIF 1229 ELSE !* Start from rest 1230 IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values' 1231 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1232 en (:,:,:) = rn_emin 1233 mxln(:,:,:) = 0.001 1234 ! Initialize bottom stresses 1235 DO jj = 2, jpjm1 1236 DO ji = fs_2, fs_jpim1 ! vector opt. 1237 ikbu = mbku(ji,jj) + 1 ! k bottom level of uw-point 1238 ikbum1 = mbku(ji,jj) ! k-1 bottom level of u -point, but >=1 1239 ikbv = mbkv(ji,jj) + 1 1240 ikbvm1 = mbkv(ji,jj) 1241 cbx = avmu(ji,jj,ikbu) / fse3uw(ji,jj,ikbu) 1242 cby = avmv(ji,jj,ikbv) / fse3vw(ji,jj,ikbv) 1243 wbotu(ji,jj) = -cbx * un(ji,jj,ikbum1) * umask(ji,jj,1) 1244 wbotv(ji,jj) = -cby * vn(ji,jj,ikbvm1) * vmask(ji,jj,1) 1245 END DO 1246 END DO 1247 ENDIF 1248 ! 1249 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 1250 ! ! ------------------- 1251 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1252 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1253 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt ) 1254 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm ) 1255 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu ) 1256 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv ) 1257 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1258 ! 1259 ENDIF 1260 ! 1170 !!--------------------------------------------------------------------- 1171 !! *** ROUTINE ts_rst *** 1172 !! 1173 !! ** Purpose : Read or write TKE file (en) in restart file 1174 !! 1175 !! ** Method : use of IOM library 1176 !! if the restart does not contain TKE, en is either 1177 !! set to rn_emin or recomputed (nn_igls/=0) 1178 !!---------------------------------------------------------------------- 1179 INTEGER , INTENT(in) :: kt ! ocean time-step 1180 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 1181 ! 1182 INTEGER :: jit, jk ! dummy loop indices 1183 INTEGER :: id1, id2, id3, id4, id5, id6, id7, id8 1184 INTEGER :: ji, jj, ikbu, ikbv 1185 REAL(wp):: cbx, cby 1186 !!---------------------------------------------------------------------- 1187 ! 1188 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 1189 ! ! --------------- 1190 IF( ln_rstart ) THEN !* Read the restart file 1191 id1 = iom_varid( numror, 'en' , ldstop = .FALSE. ) 1192 id2 = iom_varid( numror, 'avt' , ldstop = .FALSE. ) 1193 id3 = iom_varid( numror, 'avm' , ldstop = .FALSE. ) 1194 id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. ) 1195 id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. ) 1196 id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. ) 1197 id7 = iom_varid( numror, 'wbotu', ldstop = .FALSE. ) 1198 id8 = iom_varid( numror, 'wbotv', ldstop = .FALSE. ) 1199 ! 1200 IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN ! all required arrays exist 1201 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1202 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 1203 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) 1204 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu ) 1205 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 1206 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln ) 1207 CALL iom_get( numror, jpdom_autoglo, 'wbotu' , wbotu ) 1208 CALL iom_get( numror, jpdom_autoglo, 'wbotv' , wbotv ) 1209 ELSE 1210 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' 1211 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1212 en (:,:,:) = rn_emin 1213 mxln(:,:,:) = 0.001 1214 ! Initialize bottom stresses 1215 DO jj = 2, jpjm1 1216 DO ji = fs_2, fs_jpim1 ! vector opt. 1217 ikbu = mbku(ji,jj) ! bottom ocean level of u-point 1218 ikbv = mbkv(ji,jj) 1219 cbx = avmu(ji,jj,ikbu+1) / fse3uw(ji,jj,ikbu+1) 1220 cby = avmv(ji,jj,ikbv+1) / fse3vw(ji,jj,ikbv+1) 1221 wbotu(ji,jj) = -cbx * un(ji,jj,ikbu) * umask(ji,jj,1) 1222 wbotv(ji,jj) = -cby * vn(ji,jj,ikbv) * vmask(ji,jj,1) 1223 END DO 1224 END DO 1225 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_gls( jit ) ; END DO 1226 ENDIF 1227 ELSE !* Start from rest 1228 IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values' 1229 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1230 en (:,:,:) = rn_emin 1231 mxln(:,:,:) = 0.001 1232 ! Initialize bottom stresses 1233 DO jj = 2, jpjm1 1234 DO ji = fs_2, fs_jpim1 ! vector opt. 1235 ikbu = mbku(ji,jj) ! bottom ocean level of u-point 1236 ikbv = mbkv(ji,jj) 1237 cbx = avmu(ji,jj,ikbu+1) / fse3uw(ji,jj,ikbu+1) 1238 cby = avmv(ji,jj,ikbv+1) / fse3vw(ji,jj,ikbv+1) 1239 wbotu(ji,jj) = -cbx * un(ji,jj,ikbu) * umask(ji,jj,1) 1240 wbotv(ji,jj) = -cby * vn(ji,jj,ikbv) * vmask(ji,jj,1) 1241 END DO 1242 END DO 1243 ENDIF 1244 ! 1245 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 1246 ! ! ------------------- 1247 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1248 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1249 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt ) 1250 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm ) 1251 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu ) 1252 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv ) 1253 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1254 CALL iom_rstput( kt, nitrst, numrow, 'wbotu' , wbotu ) 1255 CALL iom_rstput( kt, nitrst, numrow, 'wbotv' , wbotv ) 1256 ! 1257 ENDIF 1258 ! 1261 1259 END SUBROUTINE gls_rst 1262 1260
Note: See TracChangeset
for help on using the changeset viewer.