Changeset 12377 for NEMO/trunk/src/OCE/IOM
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 7 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/in_out_manager.F90 (modified) (5 diffs)
-
src/OCE/IOM/iom.F90 (modified) (23 diffs)
-
src/OCE/IOM/iom_def.F90 (modified) (1 diff)
-
src/OCE/IOM/iom_nf90.F90 (modified) (8 diffs)
-
src/OCE/IOM/prtctl.F90 (modified) (2 diffs)
-
src/OCE/IOM/restart.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/IOM/in_out_manager.F90
r11536 r12377 87 87 LOGICAL :: lrst_oce !: logical to control the oce restart write 88 88 LOGICAL :: lrst_ice !: logical to control the ice restart write 89 LOGICAL :: lrst_abl !: logical to control the abl restart write 89 90 INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 90 91 INTEGER :: numrir !: logical unit for ice restart (read) 92 INTEGER :: numrar !: logical unit for abl restart (read) 91 93 INTEGER :: numrow !: logical unit for ocean restart (write) 92 94 INTEGER :: numriw !: logical unit for ice restart (write) 95 INTEGER :: numraw !: logical unit for abl restart (write) 93 96 INTEGER :: nrst_lst !: number of restart to output next 94 97 … … 96 99 !! output monitoring 97 100 !!---------------------------------------------------------------------- 98 LOGICAL :: ln_ctl !: run control for debugging 99 TYPE :: sn_ctl !: optional use structure for finer control over output selection 101 TYPE :: sn_ctl !: structure for control over output selection 102 LOGICAL :: l_glochk = .FALSE. !: range sanity checks are local (F) or global (T) 103 ! Use global setting for debugging only; 104 ! local breaches will still be reported 105 ! and stop the code in most cases. 106 LOGICAL :: l_allon = .FALSE. !: overall control; activate all following output options 100 107 LOGICAL :: l_config = .FALSE. !: activate/deactivate finer control 101 ! Note if l_config is True then ln_ctl is ignored. 102 ! Otherwise setting ln_ctl True is equivalent to setting 103 ! all the following logicals in this structure True 108 ! Note if l_config is True then sn_cfctl%l_allon is ignored. 109 ! Otherwise setting sn_cfctl%l_allon T/F is equivalent to 110 ! setting all the following logicals in this structure T/F 111 ! and disabling subsetting of processors 104 112 LOGICAL :: l_runstat = .FALSE. !: Produce/do not produce run.stat file (T/F) 105 113 LOGICAL :: l_trcstat = .FALSE. !: Produce/do not produce tracer.stat file (T/F) 106 114 LOGICAL :: l_oceout = .FALSE. !: Produce all ocean.outputs (T) or just one (F) 107 115 LOGICAL :: l_layout = .FALSE. !: Produce all layout.dat files (T) or just one (F) 108 LOGICAL :: l_mppout = .FALSE. !: Produce/do not produce mpp.output_XXXX files (T/F) 109 LOGICAL :: l_mpptop = .FALSE. !: Produce/do not produce mpp.top.output_XXXX files (T/F) 116 LOGICAL :: l_prtctl = .FALSE. !: Produce/do not produce mpp.output_XXXX files (T/F) 117 LOGICAL :: l_prttrc = .FALSE. !: Produce/do not produce mpp.top.output_XXXX files (T/F) 118 LOGICAL :: l_oasout = .FALSE. !: Produce/do not write oasis setup info to ocean.output (T/F) 110 119 ! Optional subsetting of processor report files 111 120 ! Default settings of 0/1000000/1 should ensure all areas report. … … 139 148 INTEGER :: numnul = -1 !: logical unit for /dev/null 140 149 ! ! early output can be collected; do not change 141 INTEGER :: numnam_ref = -1 !: logical unit for reference namelist142 INTEGER :: numnam_cfg = -1 !: logical unit for configuration specific namelist143 150 INTEGER :: numond = -1 !: logical unit for Output Namelist Dynamics 144 INTEGER :: numnam_ice_ref = -1 !: logical unit for ice reference namelist145 INTEGER :: numnam_ice_cfg = -1 !: logical unit for ice reference namelist146 151 INTEGER :: numoni = -1 !: logical unit for Output Namelist Ice 147 152 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 148 153 INTEGER :: numrun = -1 !: logical unit for run statistics 149 154 INTEGER :: numdct_in = -1 !: logical unit for transports computing 150 INTEGER :: numdct_vol = -1 !: logical unit for vo ulume transports output151 INTEGER :: numdct_heat = -1 !: logical unit for heat 152 INTEGER :: numdct_salt = -1 !: logical unit for salt 155 INTEGER :: numdct_vol = -1 !: logical unit for volume transports output 156 INTEGER :: numdct_heat = -1 !: logical unit for heat transports output 157 INTEGER :: numdct_salt = -1 !: logical unit for salt transports output 153 158 INTEGER :: numfl = -1 !: logical unit for floats ascii output 154 159 INTEGER :: numflo = -1 !: logical unit for floats ascii output 160 ! 161 CHARACTER(LEN=:), ALLOCATABLE :: numnam_ref !: character buffer for reference namelist 162 CHARACTER(LEN=:), ALLOCATABLE :: numnam_cfg !: character buffer for configuration specific namelist 163 CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_ref !: character buffer for ice reference namelist 164 CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_cfg !: character buffer for ice configuration specific namelist 155 165 156 166 !!---------------------------------------------------------------------- … … 165 175 CHARACTER(lc) :: ctmp10 !: temporary character 10 166 176 LOGICAL :: lwm = .FALSE. !: boolean : true on the 1st processor only (always) 167 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. ln_ctl177 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. sn_cfctl%l_oceout=T 168 178 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 169 179 CHARACTER(lc) :: cxios_context !: context name used in xios … … 171 181 CHARACTER(lc) :: cwxios_context !: context name used in xios to write restart file 172 182 183 !! * Substitutions 184 # include "do_loop_substitute.h90" 173 185 !!---------------------------------------------------------------------- 174 186 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/IOM/iom.F90
r12283 r12377 29 29 USE lib_mpp ! MPP library 30 30 #if defined key_iomput 31 USE sbc_oce , ONLY : nn_fsbc ! ocean space and time domain 32 USE trc_oce , ONLY : nn_dttrc ! !: frequency of step on passive tracers 31 USE sbc_oce , ONLY : nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 33 32 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes 34 33 #if defined key_si3 … … 46 45 #endif 47 46 USE lib_fortran 48 USE diu rnal_bulk, ONLY : ln_diurnal_only, ln_diurnal47 USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 49 48 50 49 IMPLICIT NONE … … 56 55 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 57 56 #endif 58 PUBLIC iom_init, iom_ swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var57 PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var 59 58 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 60 PUBLIC iom_use, iom_context_finalize, iom_ miss_val59 PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 61 60 62 61 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 65 64 #if defined key_iomput 66 65 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 67 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_ update_file_name, iom_sdate66 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 68 67 PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 69 68 # endif … … 86 85 END INTERFACE iom_put 87 86 87 !! * Substitutions 88 # include "do_loop_substitute.h90" 88 89 !!---------------------------------------------------------------------- 89 90 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 93 94 CONTAINS 94 95 95 SUBROUTINE iom_init( cdname, fname, ld_tmppatch )96 SUBROUTINE iom_init( cdname, fname, ld_tmppatch, ld_closedef ) 96 97 !!---------------------------------------------------------------------- 97 98 !! *** ROUTINE *** … … 103 104 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 104 105 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch 106 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 105 107 #if defined key_iomput 106 108 ! … … 113 115 ! 114 116 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 117 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 115 118 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 116 119 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files 117 120 INTEGER :: nldj_save, nlej_save !: 121 LOGICAL :: ll_closedef = .TRUE. 118 122 !!---------------------------------------------------------------------- 119 123 ! … … 130 134 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 131 135 ENDIF 136 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 132 137 ! 133 138 ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) … … 200 205 ! vertical grid definition 201 206 IF(.NOT.llrst_context) THEN 202 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 203 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 204 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 205 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 206 207 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 208 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 209 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 210 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 211 212 ! ABL 213 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 214 ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom 215 ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp 216 e3t_abl(:) = -1._wp ; e3w_abl(:) = -1._wp 217 ENDIF 218 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 219 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 220 207 221 ! Add vertical grid bounds 208 222 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) … … 213 227 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 214 228 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 215 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 216 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 217 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 218 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 229 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 230 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 231 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 232 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 233 234 ! ABL 235 za_bnds(1,:) = ghw_abl(1:jpkam1) 236 za_bnds(2,:) = ghw_abl(2:jpka ) 237 CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 238 za_bnds(1,:) = ght_abl(2:jpka ) 239 za_bnds(2,:) = ght_abl(2:jpka ) + e3w_abl(2:jpka) 240 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 241 219 242 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 220 243 # if defined key_si3 … … 250 273 ENDIF 251 274 ! 252 ! end file definition275 ! set time step length 253 276 dtime%second = rdt 254 277 CALL xios_set_timestep( dtime ) 255 CALL xios_close_context_definition() 256 CALL xios_update_calendar( 0 ) 278 ! 279 ! conditional closure of context definition 280 IF ( ll_closedef ) CALL iom_init_closedef 257 281 ! 258 282 DEALLOCATE( zt_bnds, zw_bnds ) … … 265 289 ! 266 290 END SUBROUTINE iom_init 291 292 SUBROUTINE iom_init_closedef 293 !!---------------------------------------------------------------------- 294 !! *** SUBROUTINE iom_init_closedef *** 295 !!---------------------------------------------------------------------- 296 !! 297 !! ** Purpose : Closure of context definition 298 !! 299 !!---------------------------------------------------------------------- 300 301 #if defined key_iomput 302 CALL xios_close_context_definition() 303 CALL xios_update_calendar( 0 ) 304 #else 305 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings 306 #endif 307 308 END SUBROUTINE iom_init_closedef 267 309 268 310 SUBROUTINE iom_set_rstw_var_active(field) … … 382 424 CALL iom_set_rstw_var_active('sshn') 383 425 CALL iom_set_rstw_var_active('rhop') 384 ! extra variable needed for the ice sheet coupling385 IF ( ln_iscpl ) THEN386 CALL iom_set_rstw_var_active('tmask')387 CALL iom_set_rstw_var_active('umask')388 CALL iom_set_rstw_var_active('vmask')389 CALL iom_set_rstw_var_active('smask')390 CALL iom_set_rstw_var_active('e3t_n')391 CALL iom_set_rstw_var_active('e3u_n')392 CALL iom_set_rstw_var_active('e3v_n')393 CALL iom_set_rstw_var_active('gdepw_n')394 END IF395 426 ENDIF 396 427 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') … … 701 732 clname = trim(cdname) 702 733 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 703 !FUS iln = INDEX(clname,'/') 704 iln = INDEX(clname,'/',BACK=.true.) ! FUS: to insert the nest index at the right location within the string, the last / has to be found (search from the right to left) 734 iln = INDEX(clname,'/') 705 735 cltmpn = clname(1:iln) 706 736 clname = clname(iln+1:LEN_TRIM(clname)) … … 1149 1179 WRITE(cldmspc , fmt='(i1)') idmspc 1150 1180 ! 1151 IF( idmspc < irankpv ) THEN 1152 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1153 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1154 ELSEIF( idmspc == irankpv ) THEN 1181 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1182 !IF( idmspc < irankpv ) THEN 1183 ! CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1184 ! & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1185 !ELSEIF( idmspc == irankpv ) THEN 1186 IF( idmspc == irankpv ) THEN 1155 1187 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1156 1188 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) … … 1732 1764 1733 1765 SUBROUTINE iom_p4d( cdname, pfield4d ) 1734 CHARACTER(LEN=*) 1766 CHARACTER(LEN=*) , INTENT(in) :: cdname 1735 1767 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1736 1768 #if defined key_iomput … … 1974 2006 ! 1975 2007 INTEGER :: ji, jj, jn, ni, nj 1976 INTEGER :: icnr, jcnr 1977 ! 2008 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 2009 ! ! represents the bottom-left corner of cell (i,j) 1978 2010 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1979 2011 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells … … 2145 2177 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 2146 2178 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 2147 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 2148 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 2179 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ABL' , freq_op=f_op, freq_offset=f_of) 2149 2180 2150 2181 ! output file names (attribut: name) … … 2271 2302 CHARACTER(LEN=20) :: clfreq 2272 2303 CHARACTER(LEN=20) :: cldate 2273 CHARACTER(LEN=256) :: cltmpn !FUS needed for correct path with AGRIF2274 INTEGER :: iln !FUS needed for correct path with AGRIF2275 2304 INTEGER :: idx 2276 2305 INTEGER :: jn … … 2355 2384 END DO 2356 2385 ! 2357 !FUS IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 2358 !FUS see comment line 700 2359 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN 2360 iln = INDEX(clname,'/',BACK=.true.) 2361 cltmpn = clname(1:iln) 2362 clname = clname(iln+1:LEN_TRIM(clname)) 2363 clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 2364 ENDIF 2365 !FUS 2386 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 2366 2387 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 2367 2388 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 2442 2463 END SUBROUTINE iom_context_finalize 2443 2464 2465 SUBROUTINE iom_update_file_name( cdid ) 2466 CHARACTER(LEN=*), INTENT(in) :: cdid 2467 IF( .FALSE. ) WRITE(numout,*) cdid ! useless test to avoid compilation warnings 2468 END SUBROUTINE iom_update_file_name 2469 2444 2470 #endif 2445 2471 … … 2461 2487 #else 2462 2488 IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings 2489 IF( .FALSE. ) pmiss_val = 0._wp ! useless assignment to avoid compilation warnings 2463 2490 #endif 2464 2491 END SUBROUTINE iom_miss_val -
NEMO/trunk/src/OCE/IOM/iom_def.F90
r10425 r12377 77 77 TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields) 78 78 ! 79 !! * Substitutions 80 # include "do_loop_substitute.h90" 79 81 !!---------------------------------------------------------------------- 80 82 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/IOM/iom_nf90.F90
r11536 r12377 19 19 !!---------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height 21 22 USE lbclnk ! lateal boundary condition / mpp exchanges 22 23 USE iom_def ! iom variables definitions … … 56 57 LOGICAL , INTENT(in ) :: ldok ! check the existence 57 58 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 58 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the third dimension59 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the ice/abl third dimension 59 60 60 61 CHARACTER(LEN=256) :: clinfo ! info character … … 69 70 INTEGER :: ihdf5 ! local variable for retrieval of value for NF90_HDF5 70 71 LOGICAL :: llclobber ! local definition of ln_clobber 71 INTEGER :: ilevels 72 INTEGER :: ilevels ! vertical levels 72 73 !--------------------------------------------------------------------- 73 74 ! … … 76 77 ! 77 78 ! !number of vertical levels 78 IF( PRESENT(kdlev) ) THEN ; ilevels = kdlev ! use input value (useful for sea-ice)79 ELSE ; ilevels = jpk ! by default jpk79 IF( PRESENT(kdlev) ) THEN ; ilevels = kdlev ! use input value (useful for sea-ice and abl) 80 ELSE ; ilevels = jpk ! by default jpk 80 81 ENDIF 81 82 ! … … 126 127 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo) 127 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 129 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 130 IF( PRESENT(kdlev) ) & 131 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 129 IF( PRESENT(kdlev) ) THEN 130 IF( kdlev == jpka ) THEN 131 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', kdlev, idmy ), clinfo) 132 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 133 ELSE 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 137 ENDIF 138 ELSE 139 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 140 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 141 ENDIF 132 142 ! global attributes 133 143 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) … … 196 206 CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable 197 207 INTEGER , INTENT(in ) :: kiv ! 198 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions199 INTEGER , INTENT( out), OPTIONAL :: kndims ! size of thedimensions208 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of each dimension 209 INTEGER , INTENT( out), OPTIONAL :: kndims ! number of dimensions 200 210 LOGICAL , INTENT( out), OPTIONAL :: lduld ! true if the last dimension is unlimited (time) 201 211 ! … … 584 594 IF( PRESENT(pv_r0d) ) THEN ; idims = 0 585 595 ELSEIF( PRESENT(pv_r1d) ) THEN 586 IF( SIZE(pv_r1d,1) == jpk) THEN ; idim3 = 3587 ELSE ; idim3 = 5596 IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN ; idim3 = 3 597 ELSE ; idim3 = 5 588 598 ENDIF 589 599 idims = 2 ; idimid(1:idims) = (/idim3,4/) 590 600 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/) 591 601 ELSEIF( PRESENT(pv_r3d) ) THEN 592 IF( SIZE(pv_r3d,3) == jpk) THEN ; idim3 = 3593 ELSE ; idim3 = 5602 IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN ; idim3 = 3 603 ELSE ; idim3 = 5 594 604 ENDIF 595 605 idims = 4 ; idimid(1:idims) = (/1,2,idim3,4/) … … 674 684 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 675 685 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo ) 676 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gdept_1d ), clinfo ) 686 IF (iom_file(kiomid)%nlev == jpka) THEN ; CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, ght_abl), clinfo ) 687 ELSE ; CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gdept_1d), clinfo ) 688 ENDIF 677 689 IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 678 690 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) -
NEMO/trunk/src/OCE/IOM/prtctl.F90
r10068 r12377 50 50 !! debugging a new parametrization in mono or mpp. 51 51 !! 52 !! ** Method : 2 possibilities exist when setting the ln_ctl parameter to52 !! ** Method : 2 possibilities exist when setting the sn_cfctl%prtctl parameter to 53 53 !! .true. in the ocean namelist: 54 54 !! - to debug a MPI run .vs. a mono-processor one; … … 64 64 !! name must be explicitly typed if used. For instance if the 3D 65 65 !! array tn(:,:,:) must be passed through the prt_ctl subroutine, 66 !! it must look slike: CALL prt_ctl(tab3d_1=tn).66 !! it must look like: CALL prt_ctl(tab3d_1=tn). 67 67 !! 68 68 !! tab2d_1 : first 2D array -
NEMO/trunk/src/OCE/IOM/restart.F90
r11536 r12377 27 27 USE in_out_manager ! I/O manager 28 28 USE iom ! I/O module 29 USE diu rnal_bulk29 USE diu_bulk 30 30 USE lib_mpp ! distribued memory computing library 31 31 … … 38 38 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init 39 39 40 !! * Substitutions41 # include "vectopt_loop_substitute.h90"42 40 !!---------------------------------------------------------------------- 43 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 133 131 134 132 135 SUBROUTINE rst_write( kt )133 SUBROUTINE rst_write( kt, Kbb, Kmm ) 136 134 !!--------------------------------------------------------------------- 137 135 !! *** ROUTINE rstwrite *** … … 142 140 !! file, save fields which are necessary for restart 143 141 !!---------------------------------------------------------------------- 144 INTEGER, INTENT(in) :: kt ! ocean time-step 142 INTEGER, INTENT(in) :: kt ! ocean time-step 143 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 145 144 !!---------------------------------------------------------------------- 146 145 IF(lwxios) CALL iom_swap( cwxios_context ) … … 149 148 150 149 IF ( .NOT. ln_diurnal_only ) THEN 151 CALL iom_rstput( kt, nitrst, numrow, 'ub' , u b, ldxios = lwxios ) ! before fields152 CALL iom_rstput( kt, nitrst, numrow, 'vb' , v b, ldxios = lwxios )153 CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts b(:,:,:,jp_tem), ldxios = lwxios )154 CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts b(:,:,:,jp_sal), ldxios = lwxios )155 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb, ldxios = lwxios )150 CALL iom_rstput( kt, nitrst, numrow, 'ub' , uu(:,:,: ,Kbb), ldxios = lwxios ) ! before fields 151 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vv(:,:,: ,Kbb), ldxios = lwxios ) 152 CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios ) 153 CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios ) 154 CALL iom_rstput( kt, nitrst, numrow, 'sshb' ,ssh(:,: ,Kbb), ldxios = lwxios ) 156 155 ! 157 CALL iom_rstput( kt, nitrst, numrow, 'un' , u n, ldxios = lwxios ) ! now fields158 CALL iom_rstput( kt, nitrst, numrow, 'vn' , v n, ldxios = lwxios )159 CALL iom_rstput( kt, nitrst, numrow, 'tn' , ts n(:,:,:,jp_tem), ldxios = lwxios )160 CALL iom_rstput( kt, nitrst, numrow, 'sn' , ts n(:,:,:,jp_sal), ldxios = lwxios )161 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios )156 CALL iom_rstput( kt, nitrst, numrow, 'un' , uu(:,:,: ,Kmm), ldxios = lwxios ) ! now fields 157 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vv(:,:,: ,Kmm), ldxios = lwxios ) 158 CALL iom_rstput( kt, nitrst, numrow, 'tn' , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'sn' , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 160 CALL iom_rstput( kt, nitrst, numrow, 'sshn' ,ssh(:,: ,Kmm), ldxios = lwxios ) 162 161 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 163 ! extra variable needed for the ice sheet coupling164 IF ( ln_iscpl ) THEN165 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask, ldxios = lwxios ) ! need to extrapolate T/S166 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask, ldxios = lwxios ) ! need to correct barotropic velocity167 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask, ldxios = lwxios ) ! need to correct barotropic velocity168 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask, ldxios = lwxios) ! need to correct barotropic velocity169 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) ! need to compute temperature correction170 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation171 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation172 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl173 END IF174 162 ENDIF 175 163 … … 240 228 241 229 242 SUBROUTINE rst_read 230 SUBROUTINE rst_read( Kbb, Kmm ) 243 231 !!---------------------------------------------------------------------- 244 232 !! *** ROUTINE rst_read *** … … 248 236 !! ** Method : Read in restart.nc file fields which are necessary for restart 249 237 !!---------------------------------------------------------------------- 238 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 250 239 REAL(wp) :: zrdt 251 240 INTEGER :: jk … … 270 259 rhop = rau0 271 260 CALL iom_get( numror, jpdom_autoglo, 'tn' , w3d, ldxios = lrxios ) 272 ts n(:,:,1,jp_tem) = w3d(:,:,1)261 ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 273 262 RETURN 274 263 ENDIF 275 264 276 265 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 277 CALL iom_get( numror, jpdom_autoglo, 'ub' , u b, ldxios = lrxios) ! before fields278 CALL iom_get( numror, jpdom_autoglo, 'vb' , v b, ldxios = lrxios)279 CALL iom_get( numror, jpdom_autoglo, 'tb' , ts b(:,:,:,jp_tem), ldxios = lrxios )280 CALL iom_get( numror, jpdom_autoglo, 'sb' , ts b(:,:,:,jp_sal), ldxios = lrxios )281 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, ldxios = lrxios)266 CALL iom_get( numror, jpdom_autoglo, 'ub' , uu(:,:,: ,Kbb), ldxios = lrxios ) ! before fields 267 CALL iom_get( numror, jpdom_autoglo, 'vb' , vv(:,:,: ,Kbb), ldxios = lrxios ) 268 CALL iom_get( numror, jpdom_autoglo, 'tb' , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 269 CALL iom_get( numror, jpdom_autoglo, 'sb' , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 270 CALL iom_get( numror, jpdom_autoglo, 'sshb' ,ssh(:,: ,Kbb), ldxios = lrxios ) 282 271 ELSE 283 272 neuler = 0 284 273 ENDIF 285 274 ! 286 CALL iom_get( numror, jpdom_autoglo, 'un' , u n, ldxios = lrxios )! now fields287 CALL iom_get( numror, jpdom_autoglo, 'vn' , v n, ldxios = lrxios )288 CALL iom_get( numror, jpdom_autoglo, 'tn' , ts n(:,:,:,jp_tem), ldxios = lrxios )289 CALL iom_get( numror, jpdom_autoglo, 'sn' , ts n(:,:,:,jp_sal), ldxios = lrxios )290 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios )275 CALL iom_get( numror, jpdom_autoglo, 'un' , uu(:,:,: ,Kmm), ldxios = lrxios ) ! now fields 276 CALL iom_get( numror, jpdom_autoglo, 'vn' , vv(:,:,: ,Kmm), ldxios = lrxios ) 277 CALL iom_get( numror, jpdom_autoglo, 'tn' , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 278 CALL iom_get( numror, jpdom_autoglo, 'sn' , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 279 CALL iom_get( numror, jpdom_autoglo, 'sshn' ,ssh(:,: ,Kmm), ldxios = lrxios ) 291 280 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 292 281 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop, ldxios = lrxios ) ! now potential density 293 282 ELSE 294 CALL eos( ts n, rhd, rhop, gdept_n(:,:,:) )283 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) ) 295 284 ENDIF 296 285 ! 297 286 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 298 ts b (:,:,:,:) = tsn (:,:,:,:)! all before fields set to now values299 u b (:,:,:) = un (:,:,:)300 v b (:,:,:) = vn (:,:,:)301 ssh b (:,:) = sshn (:,:)287 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values 288 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm) 289 vv (:,:,: ,Kbb) = vv (:,:,: ,Kmm) 290 ssh (:,: ,Kbb) = ssh (:,: ,Kmm) 302 291 ! 303 292 IF( .NOT.ln_linssh ) THEN 304 293 DO jk = 1, jpk 305 e3t _b(:,:,jk) = e3t_n(:,:,jk)294 e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 306 295 END DO 307 296 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
