- Timestamp:
- 2019-12-13T19:48:00+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/tests/STATION_ASF/MY_SRC/diawri.F90
r11831 r12249 25 25 !! dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields 26 26 !!---------------------------------------------------------------------- 27 USE oce ! ocean dynamics and tracers 27 USE oce ! ocean dynamics and tracers 28 28 USE dom_oce ! ocean space and time domain 29 29 USE phycst ! physical constants … … 33 33 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 34 34 USE in_out_manager ! I/O manager 35 USE iom ! 36 USE ioipsl ! 35 USE iom ! 36 USE ioipsl ! 37 37 #if defined key_si3 38 USE ice 39 USE icewri 38 USE ice 39 USE icewri 40 40 #endif 41 41 USE lib_mpp ! MPP library … … 74 74 END FUNCTION dia_wri_alloc 75 75 76 77 SUBROUTINE dia_wri( kt )76 77 SUBROUTINE dia_wri( kt, Kmm ) 78 78 !!--------------------------------------------------------------------- 79 79 !! *** ROUTINE dia_wri *** 80 !! 81 !! ** Purpose : Standard output of opa: dynamics and tracer fields 82 !! NETCDF format is used by default 83 !! Standalone surface scheme80 !! 81 !! ** Purpose : Standard output of opa: dynamics and tracer fields 82 !! NETCDF format is used by default 83 !! STATION_ASF 84 84 !! 85 85 !! ** Method : use iom_put 86 86 !!---------------------------------------------------------------------- 87 87 INTEGER, INTENT( in ) :: kt ! ocean time-step index 88 !!---------------------------------------------------------------------- 89 ! 88 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 89 !!---------------------------------------------------------------------- 90 ! 91 IF( ln_timing ) CALL timing_start('dia_wri') 92 ! 90 93 ! Output the initial state and forcings 91 IF( ninist == 1 ) THEN 92 CALL dia_wri_state( 'output.init' )94 IF( ninist == 1 ) THEN 95 CALL dia_wri_state( Kmm, 'output.init' ) 93 96 ninist = 0 94 97 ENDIF … … 99 102 CALL iom_put( "ssu", ssu_m(:,:) ) ! ocean surface current along i-axis 100 103 CALL iom_put( "ssv", ssv_m(:,:) ) ! ocean surface current along j-axis 104 ! 105 IF( ln_timing ) CALL timing_stop('dia_wri') 101 106 ! 102 107 END SUBROUTINE dia_wri … … 115 120 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 116 121 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 117 122 ! 118 123 dia_wri_alloc = MAXVAL(ierr) 119 124 CALL mpp_sum( 'diawri', dia_wri_alloc ) … … 121 126 END FUNCTION dia_wri_alloc 122 127 123 124 SUBROUTINE dia_wri( kt ) 128 129 130 SUBROUTINE dia_wri( kt, Kmm ) 125 131 !!--------------------------------------------------------------------- 126 132 !! *** ROUTINE dia_wri *** 127 !! 128 !! ** Purpose : Standard output of opa: dynamics and tracer fields 129 !! NETCDF format is used by default 130 !! 131 !! ** Method : At the beginning of the first time step (nit000), 133 !! 134 !! ** Purpose : Standard output of opa: dynamics and tracer fields 135 !! NETCDF format is used by default 136 !! 137 !! ** Method : At the beginning of the first time step (nit000), 132 138 !! define all the NETCDF files and fields 133 139 !! At each time step call histdef to compute the mean if ncessary 134 !! Each n write time step, output the instantaneous or mean fields140 !! Each nn_write time step, output the instantaneous or mean fields 135 141 !!---------------------------------------------------------------------- 136 142 INTEGER, INTENT( in ) :: kt ! ocean time-step index 143 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 137 144 ! 138 145 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 144 151 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 145 152 !!---------------------------------------------------------------------- 146 ! 153 ! 154 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 155 CALL dia_wri_state( Kmm, 'output.init' ) 156 ninist = 0 157 ENDIF 158 ! 159 IF( nn_write == -1 ) RETURN ! we will never do any output 160 ! 147 161 IF( ln_timing ) CALL timing_start('dia_wri') 148 !149 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==!150 CALL dia_wri_state( 'output.init' )151 ninist = 0152 ENDIF153 162 ! 154 163 ! 0. Initialisation … … 159 168 160 169 ! Define frequency of output and means 161 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 162 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 163 ENDIF 170 clop = "x" ! no use of the mask value (require less cpu time and otherwise the model crashes) 164 171 #if defined key_diainstant 165 zsto = n write * rdt172 zsto = nn_write * rdt 166 173 clop = "inst("//TRIM(clop)//")" 167 174 #else … … 169 176 clop = "ave("//TRIM(clop)//")" 170 177 #endif 171 zout = n write * rdt178 zout = nn_write * rdt 172 179 zmax = ( nitend - nit000 + 1 ) * rdt 173 180 … … 196 203 & ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian 197 204 IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & 198 205 ' limit storage in depth = ', ipk 199 206 200 207 ! WRITE root name in date.file for use by postpro 201 208 IF(lwp) THEN 202 CALL dia_nam( clhstnam, n write,' ' )209 CALL dia_nam( clhstnam, nn_write,' ' ) 203 210 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 204 211 WRITE(inum,*) clhstnam … … 208 215 ! Define the T grid FILE ( nid_T ) 209 216 210 CALL dia_nam( clhstnam, n write, 'grid_T' )217 CALL dia_nam( clhstnam, nn_write, 'grid_T' ) 211 218 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 212 219 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit … … 220 227 ! Define the U grid FILE ( nid_U ) 221 228 222 CALL dia_nam( clhstnam, n write, 'grid_U' )229 CALL dia_nam( clhstnam, nn_write, 'grid_U' ) 223 230 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 224 231 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu … … 232 239 ! Define the V grid FILE ( nid_V ) 233 240 234 CALL dia_nam( clhstnam, n write, 'grid_V' ) ! filename241 CALL dia_nam( clhstnam, nn_write, 'grid_V' ) ! filename 235 242 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 236 243 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv … … 254 261 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 255 262 CALL histdef( nid_T, "sosfldow", "downward salt flux" , "PSU/m2/s", & ! (sfx) 256 263 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 257 264 CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr 258 265 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 291 298 ! --------------------- 292 299 293 ! ndex(1) est utilise ssi l'avant dernier argument est different de 300 ! ndex(1) est utilise ssi l'avant dernier argument est different de 294 301 ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 295 302 ! donne le nombre d'elements, et ndex la liste des indices a sortir 296 303 297 IF( lwp .AND. MOD( itmod, n write ) == 0 ) THEN304 IF( lwp .AND. MOD( itmod, nn_write ) == 0 ) THEN 298 305 WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step' 299 306 WRITE(numout,*) '~~~~~~ ' … … 304 311 CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT ) ! sea surface salinity 305 312 CALL histwrite( nid_T, "sowaflup", it, (emp - rnf ) , ndim_hT, ndex_hT ) ! upward water flux 306 CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux 307 ! (includes virtual salt flux beneath ice308 313 CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux 314 ! (includes virtual salt flux beneath ice 315 ! in linear free surface case) 309 316 310 317 CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux 311 318 CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux 312 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 313 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 314 315 319 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 320 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 321 322 ! Write fields on U grid 316 323 CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed 317 324 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress 318 325 319 326 ! Write fields on V grid 320 327 CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed 321 328 CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress … … 334 341 #endif 335 342 336 SUBROUTINE dia_wri_state( cdfile_name )343 SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 337 344 !!--------------------------------------------------------------------- 338 345 !! *** ROUTINE dia_wri_state *** 339 !! 340 !! ** Purpose : create a NetCDF file named cdfile_name which contains 346 !! 347 !! ** Purpose : create a NetCDF file named cdfile_name which contains 341 348 !! the instantaneous ocean state and forcing fields. 342 349 !! Used to find errors in the initial state or save the last … … 347 354 !! File 'output.abort.nc' is created in case of abnormal job end 348 355 !!---------------------------------------------------------------------- 356 INTEGER , INTENT( in ) :: Kmm ! time level index 349 357 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 350 358 !! 351 359 INTEGER :: inum 352 360 !!---------------------------------------------------------------------- 353 ! 361 ! 354 362 IF(lwp) WRITE(numout,*) 355 363 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' … … 358 366 359 367 #if defined key_si3 360 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )368 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 361 369 #else 362 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )363 #endif 364 365 CALL iom_rstput( 0, 0, inum, 'votemper', ts n(:,:,:,jp_tem) ) ! now temperature366 CALL iom_rstput( 0, 0, inum, 'vosaline', ts n(:,:,:,jp_sal) ) ! now salinity367 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh n) ! sea surface height368 CALL iom_rstput( 0, 0, inum, 'vozocrtx', u n) ! now i-velocity369 CALL iom_rstput( 0, 0, inum, 'vomecrty', v n) ! now j-velocity370 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn) ! now k-velocity370 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 371 #endif 372 373 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 374 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity 375 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm) ) ! sea surface height 376 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm) ) ! now i-velocity 377 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity 378 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity 371 379 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 372 380 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux … … 375 383 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 376 384 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 377 385 378 386 #if defined key_si3 379 387 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid … … 383 391 ! 384 392 CALL iom_close( inum ) 385 ! 393 ! 386 394 END SUBROUTINE dia_wri_state 387 395
Note: See TracChangeset
for help on using the changeset viewer.
