Changeset 508 for trunk/NEMO/OPA_SRC/iom.F90
- Timestamp:
- 2006-10-03T17:58:55+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/iom.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/iom.F90
r485 r508 2 2 !!===================================================================== 3 3 !! *** MODULE iom *** 4 !!5 4 !! Input/Output manager : Library to read input files 6 !!7 !! Ongoing work : This code is here to help discussions about I/O8 !! library in the NEMO system9 5 !!==================================================================== 6 !! History : 9.0 ! 05 12 (J. Belier) Original code 7 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO 8 !!-------------------------------------------------------------------- 9 !!gm caution add !DIR nec: improved performance to be checked as well as no result changes 10 10 11 !!-------------------------------------------------------------------- 11 12 !! iom_open : open a file read only 12 13 !! iom_close : close a file or all files opened by iom 13 !! iom_get : read a field : interface to several routines 14 !! iom_get : read a field (interfaced to several routines) 15 !! iom_gettime : read the time axis cdvar in the file !!gm : never call ?????? 14 16 !! iom_varid : get the id of a variable in a file 15 !! iom_ get_gblatt : ???17 !! iom_rstput : write a field in a restart file (interfaced to several routines) 16 18 !!-------------------------------------------------------------------- 17 !! History : 9.0 ! 05 12 (J. Belier) Original code18 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO19 !!--------------------------------------------------------------------20 !! * Modules used21 19 USE in_out_manager ! I/O manager 22 20 USE dom_oce ! ocean space and time domain 23 USE lbclnk ! ???24 USE ioipsl ! ???21 USE lbclnk ! lateal boundary condition / mpp exchanges 22 USE ioipsl ! IOIPSL library 25 23 26 24 IMPLICIT NONE 27 25 PRIVATE 28 26 29 PUBLIC iom_open, iom_close, iom_get, iom_varid, iom_get_gblatt 30 31 !! * Interfaces 27 PUBLIC iom_open, iom_close, iom_get, iom_varid, iom_rstput, iom_gettime 28 32 29 INTERFACE iom_get 33 MODULE PROCEDURE iom_get_r_ 1d, iom_get_r_2d, iom_get_r_3d30 MODULE PROCEDURE iom_get_r_0d, iom_get_r_1d, iom_get_r_2d, iom_get_r_3d 34 31 END INTERFACE 35 36 !! * Share module variables 37 INTEGER, PARAMETER, PUBLIC :: & !: 38 jpdom_data = 1, & !: ( 1 :jpidta, 1 :jpjdta) 39 jpdom_global = 2, & !: ( 1 :jpiglo, 1 :jpjglo) 40 jpdom_local = 3, & !: One of the 3 following cases 41 jpdom_local_full = 4, & !: ( 1 :jpi , 1 :jpi ) 42 jpdom_local_noextra = 5, & !: ( 1 :nlci , 1 :nlcj ) 43 jpdom_local_noovlap = 6, & !: (nldi:nlei ,nldj:nlej ) 44 jpdom_unknown = 7 !: No dimension checking 45 46 !! * Module variables 47 INTEGER, PARAMETER :: & 48 jpmax_vars = 50, & ! maximum number of variables in one file 49 jpmax_dims = 5, & ! maximum number of dimensions for one variable 50 jpmax_digits = 5 ! maximum number of digits in the file name to reference the cpu number 51 32 INTERFACE iom_rstput 33 MODULE PROCEDURE iom_rstput_0d, iom_rstput_1d, iom_rstput_2d, iom_rstput_3d 34 END INTERFACE 35 36 INTEGER, PARAMETER, PUBLIC :: jpdom_data = 1 !: ( 1 :jpidta, 1 :jpjdta) 37 INTEGER, PARAMETER, PUBLIC :: jpdom_global = 2 !: ( 1 :jpiglo, 1 :jpjglo) 38 INTEGER, PARAMETER, PUBLIC :: jpdom_local = 3 !: One of the 3 following cases 39 INTEGER, PARAMETER, PUBLIC :: jpdom_local_full = 4 !: ( 1 :jpi , 1 :jpi ) 40 INTEGER, PARAMETER, PUBLIC :: jpdom_local_noextra = 5 !: ( 1 :nlci , 1 :nlcj ) 41 INTEGER, PARAMETER, PUBLIC :: jpdom_local_noovlap = 6 !: (nldi:nlei ,nldj:nlej ) 42 INTEGER, PARAMETER, PUBLIC :: jpdom_unknown = 7 !: No dimension checking 43 44 INTEGER, PARAMETER :: jpmax_vars = 60, & ! maximum number of variables in one file 45 & jpmax_dims = 4, & ! maximum number of dimensions for one variable 46 & jpmax_digits = 5 ! maximum number of digits for the cpu number in the file name 52 47 !$AGRIF_DO_NOT_TREAT 53 INTEGER :: iom_init = 0 54 55 TYPE :: flio_file 48 INTEGER :: iom_init = 0 49 TYPE :: flio_file 56 50 CHARACTER(LEN=240) :: name ! name of the file 57 INTEGER :: iopen ! 1 /0 is the file is open/not open51 INTEGER :: iopen ! 1(0) if the file is open(not open) 58 52 INTEGER :: nvars ! number of identified varibles in the file 59 53 INTEGER :: iduld ! id of the unlimited dimension 60 54 CHARACTER(LEN=16), DIMENSION(jpmax_vars) :: cn_var ! names of the variables 61 55 INTEGER, DIMENSION(jpmax_vars) :: ndims ! number of dimensions of the variables 62 LOGICAL, DIMENSION(jpmax_vars) :: luld ! variable includingunlimited dimension63 INTEGER, DIMENSION(jpmax_dims,jpmax_vars) :: dimsz ! size of the dimensions of the variables56 LOGICAL, DIMENSION(jpmax_vars) :: luld ! variable using the unlimited dimension 57 INTEGER, DIMENSION(jpmax_dims,jpmax_vars) :: dimsz ! size of variables dimensions 64 58 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf ! scale_factor of the variables 65 59 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs ! add_offset of the variables 66 60 END TYPE flio_file 67 TYPE(flio_file), DIMENSION(flio_max_files) :: iom_file ! array containing the info for all opened files61 TYPE(flio_file), DIMENSION(flio_max_files) :: iom_file ! array containing the info for all opened files 68 62 !$AGRIF_END_DO_NOT_TREAT 69 63 … … 76 70 CONTAINS 77 71 78 SUBROUTINE iom_open( cdname, knumfl, ld img )72 SUBROUTINE iom_open( cdname, knumfl, ldwrt, kdom, ldimg ) 79 73 !!--------------------------------------------------------------------- 80 74 !! *** SUBROUTINE iom_open *** 81 75 !! 82 76 !! ** Purpose : open an input file read only (return 0 if not found) 83 !!84 !! ** Method :85 !!86 77 !!--------------------------------------------------------------------- 87 CHARACTER(len=*), INTENT(in ) :: cdname ! File name 88 INTEGER, INTENT(out) :: knumfl ! Identifier of the opened file 89 LOGICAL, INTENT(in ), OPTIONAL :: ldimg ! flg to specify that we use dimg format 90 91 CHARACTER(LEN=100) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 92 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg" 93 CHARACTER(LEN=10) :: clcpu ! the cpu number (max jpmax_digits digits) 94 LOGICAL :: llok ! check the existence 95 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 78 CHARACTER(len=*), INTENT(in ) :: cdname ! File name 79 INTEGER , INTENT( out) :: knumfl ! Identifier of the opened file 80 LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! read or write the file? 81 INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written 82 LOGICAL , INTENT(in ), OPTIONAL :: ldimg ! use dimg format? 83 84 CHARACTER(LEN=100) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 85 CHARACTER(LEN=100) :: cltmpn ! tempory name to store clname (in writting mode) 86 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg" 87 CHARACTER(LEN=10) :: clcpu ! the cpu number (max jpmax_digits digits) 88 LOGICAL :: llok ! check the existence 89 LOGICAL :: llwrt ! 90 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 91 INTEGER :: iln, ils ! lengths of character 92 INTEGER :: idom ! type of domain 93 INTEGER :: ifliodom ! model domain identifier (see flio_dom_set) 94 INTEGER, DIMENSION(2) :: iszl ! local number of points for x,y dimensions 95 INTEGER, DIMENSION(2) :: ifst ! position of first local point for x,y dimensions 96 INTEGER, DIMENSION(2) :: ilst ! position of last local point for x,y dimensions 97 INTEGER, DIMENSION(2) :: ihst ! start halo size for x,y dimensions 98 INTEGER, DIMENSION(2) :: ihnd ! end halo size for x,y dimensions 96 99 !--------------------------------------------------------------------- 97 98 ! find the file 100 ! if iom_open is called for the first time: initialize iom_file(:)%iopen to 0 101 ! (could be done when defining iom_file in f95 but not in f90) 102 IF( iom_init == 0 ) THEN 103 iom_file(:)%iopen = 0 104 iom_init = 1 105 ENDIF 106 ! do we read or write the file? 107 ! ============= 108 IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt 109 ELSE ; llwrt = .FALSE. 110 ENDIF 111 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 99 112 ! ============= 100 113 clname = trim(cdname) 101 114 #if defined key_agrif 102 115 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 103 #endif 116 #endif 117 ! which suffix should we use? 104 118 clsuffix = ".nc" 105 IF( PRESENT(ldimg) ) THEN 106 IF ( ldimg ) clsuffix = ".dimg" 107 ENDIF 108 ! 119 IF( PRESENT(ldimg) ) THEN ; IF( ldimg ) clsuffix = ".dimg" ; ENDIF 120 ! Add the suffix if needed 121 iln = LEN_TRIM(clname) 122 ils = LEN_TRIM(clsuffix) 123 IF( iln <= ils) clname = clname(1:iln)//TRIM(clsuffix) 124 IF( clname(iln-ils+1:iln) /= TRIM(clsuffix) ) clname = clname(1:iln)//TRIM(clsuffix) 125 cltmpn = clname ! store this name 126 ! try to find if the file to be opened already exist 109 127 INQUIRE( FILE = clname, EXIST = llok ) 110 IF( .NOT.llok ) THEN ! try to complete the name with the suffix only 111 clname = TRIM(cdname)//TRIM(clsuffix) 112 #if defined key_agrif 113 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 114 #endif 115 INQUIRE( FILE = clname, EXIST = llok ) 116 IF( .NOT.llok ) THEN ! try to complete the name with both cpu number and suffix 117 WRITE(clcpu,*) narea-1 118 clcpu = trim(adjustl(clcpu)) 119 clname = trim(cdname)//"_" 120 #if defined key_agrif 121 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 122 #endif 123 icnt = 0 124 INQUIRE( FILE = trim(clname)//trim(clcpu)//trim(clsuffix), EXIST = llok ) 125 DO WHILE( .NOT.llok .AND. icnt < jpmax_digits ) ! we try fifferent formats for the cpu number by adding 0 126 clname = trim(clname)//"0" 127 INQUIRE( FILE = trim(clname)//trim(clcpu)//trim(clsuffix), EXIST = llok ) 128 icnt = icnt + 1 129 END DO 130 IF( .NOT.llok ) THEN ! no way to find the files... 131 CALL ctl_stop( 'iom_open: file '//trim(clname)//'... not found' ) 128 IF( .NOT.llok ) THEN 129 ! we try to add the cpu number to the name 130 WRITE(clcpu,*) narea-1 131 clcpu = TRIM(ADJUSTL(clcpu)) 132 iln = INDEX(clname,TRIM(clsuffix)) 133 clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 134 icnt = 0 135 INQUIRE( FILE = clname, EXIST = llok ) 136 ! we try different formats for the cpu number by adding 0 137 DO WHILE( .NOT.llok .AND. icnt < jpmax_digits ) 138 clcpu = "0"//trim(clcpu) 139 clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 140 INQUIRE( FILE = clname, EXIST = llok ) 141 icnt = icnt + 1 142 END DO 143 ENDIF 144 ! 145 IF( llok ) THEN ! Open the file 146 ! ! ============= 147 IF( llwrt ) THEN 148 IF(lwp) WRITE(numout,*) ' iom_open ~~~ open existing file: '//TRIM(clname)//' in WRITE mode' 149 CALL flioopfd( TRIM(clname), knumfl, "WRITE" ) 150 ELSE 151 IF(lwp) WRITE(numout,*) ' iom_open ~~~ open existing file: '//TRIM(clname)//' in READ mode' 152 CALL flioopfd( TRIM(clname), knumfl ) 153 ENDIF 154 ELSE ! no way to find the file... 155 ! ! ======================= 156 IF( llwrt ) THEN 157 ! file opened in write mode 158 ! the file does not exist, we must create it... 159 ! ============= 160 llok = .TRUE. 161 ! on which domain must the file be written?? 162 ! check the domain definition 163 idom = jpdom_local_noovlap ! default definition 164 IF( PRESENT(kdom) ) idom = kdom 165 ! create the domain informations 166 ! ============= 167 SELECT CASE (idom) 168 CASE (jpdom_local_full) 169 iszl = (/ jpi , jpj /) 170 ifst = (/ nimpp , njmpp /) 171 ilst = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /) 172 ihst = (/ nldi - 1 , nldj - 1 /) 173 ihnd = (/ jpi - nlei , jpj - nlej /) 174 CASE (jpdom_local_noextra) 175 iszl = (/ nlci , nlcj /) 176 ifst = (/ nimpp , njmpp /) 177 ilst = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 178 ihst = (/ nldi - 1 , nldj - 1 /) 179 ihnd = (/ nlci - nlei , nlcj - nlej /) 180 CASE (jpdom_local_noovlap) 181 iszl = (/ nlei - nldi + 1 , nlej - nldj + 1 /) 182 ifst = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 183 ilst = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 184 ihst = (/ 0 , 0 /) 185 ihnd = (/ 0 , 0 /) 186 CASE DEFAULT 187 llok = .FALSE. 188 CALL ctl_stop( 'iom_open: wrong value of kdom, only jpdom_local* cases are accepted' ) 189 END SELECT 190 IF( llok ) THEN 191 CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/) & 192 & , iszl, ifst, ilst, ihst, ihnd, 'BOX', ifliodom ) 193 ! create the file 194 ! ============= 195 ! Note that fliocrfd may change the value of clname (add the cpu number...) 196 clname = cltmpn ! get back the file name without the cpu number in it 197 IF(lwp) WRITE(numout,*) ' iom_open ~~~ create new file: '//trim(clname)//' in WRITE mode' 198 CALL fliocrfd( clname, (/'x' , 'y' , 'z', 't'/) & 199 & , (/iszl(1), iszl(2), jpk, -1 /) & 200 & , knumfl, ifliodom ) 132 201 ENDIF 133 clname = trim(clname)//trim(clcpu)//trim(clsuffix) 202 ELSE 203 ! the file is open for read-only, it must exist... 204 iln = INDEX( cltmpn,TRIM(clsuffix) ) 205 CALL ctl_stop( 'iom_open: file '//cltmpn(1:iln-1)//'* not found' ) 134 206 ENDIF 135 207 ENDIF 136 137 ! Open the file 208 ! start to fill the information of opened files 138 209 ! ============= 139 210 IF( llok ) THEN 140 IF (lwp) WRITE(numout,*) 'iom_open ~~~ open file: '//trim(clname)141 CALL flioopfd( trim(clname), knumfl )142 IF( iom_init == 0 ) THEN143 iom_file(:)%iopen = 0144 iom_init = 1145 ENDIF146 211 iom_file(knumfl)%iopen = 1 147 212 iom_file(knumfl)%name = TRIM(clname) … … 152 217 ! does the file contain time axis (that must be unlimitted) ? 153 218 CALL flioinqf( knumfl, id_uld = iom_file(knumfl)%iduld ) 219 IF(lwp) WRITE(numout,*) ' ---> OK' 154 220 ELSE 155 knumfl = 0 156 ENDIF 157 221 knumfl = 0 ! return error flag 222 ENDIF 223 ! 158 224 END SUBROUTINE iom_open 159 225 … … 164 230 !! 165 231 !! ** Purpose : close an input file, or all files opened by iom 166 !!167 !! ** Method :168 !!169 232 !!-------------------------------------------------------------------- 170 INTEGER,INTENT(in), OPTIONAL :: knumfl ! Identifier of the file to be closed 171 ! ! If this argument is not present, 172 ! ! all the files opened by iom are closed. 173 174 INTEGER :: jf ! dummy loop indices 175 INTEGER :: i_s, i_e ! temporary integer 233 INTEGER, INTENT(in), OPTIONAL :: knumfl ! Identifier of the file to be closed 234 ! ! No argument : all the files opened by iom are closed 235 236 INTEGER :: jf ! dummy loop indices 237 INTEGER :: i_s, i_e ! temporary integer 176 238 !--------------------------------------------------------------------- 177 239 ! 178 240 IF( PRESENT(knumfl) ) THEN 179 241 i_s = knumfl … … 183 245 i_e = flio_max_files 184 246 ENDIF 185 IF ( i_s > 0 ) THEN 247 248 IF( i_s > 0 ) THEN 186 249 DO jf = i_s, i_e 187 250 IF( iom_file(jf)%iopen > 0 ) THEN 188 251 CALL flioclo( jf ) 252 IF(lwp) WRITE(numout,*) ' iom_close, close file: '//TRIM(iom_file(knumfl)%name)//' ok' 189 253 iom_file(jf)%iopen = 0 190 254 iom_file(jf)%name = 'NONE' … … 200 264 END DO 201 265 ENDIF 202 266 ! 203 267 END SUBROUTINE iom_close 204 268 205 269 206 270 !!---------------------------------------------------------------------- 207 !! INTERFACE iom_ u_getv271 !! INTERFACE iom_get_123d 208 272 !!---------------------------------------------------------------------- 209 SUBROUTINE iom_get_r_1d( knumfl, kdom , cdvar , pvar , & 210 & ktime, kstart, kcount ) 211 INTEGER , INTENT(in ) :: knumfl ! Identifier of the file 212 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 213 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 214 REAL(wp), DIMENSION(:), INTENT(out) :: pvar ! read field 215 INTEGER , INTENT(in ) ,OPTIONAL :: ktime ! record number 216 INTEGER , DIMENSION(:), INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 217 INTEGER , DIMENSION(:), INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 218 ! 219 CHARACTER(LEN=100) :: clinfo ! info character 220 ! 221 clinfo = 'iom_get_r_1d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 222 IF( PRESENT(kstart) ) THEN 223 IF ( SIZE(kstart) /= 1 ) CALL ctl_stop( trim(clinfo), 'kstart must be a 1 element vector' ) 224 ENDIF 225 IF( PRESENT(kcount) ) THEN 226 IF ( SIZE(kcount) /= 1 ) CALL ctl_stop( trim(clinfo), 'kcount must be a 1 element vector' ) 227 ENDIF 228 IF ( knumfl > 0 ) CALL iom_u_getv( knumfl, kdom , cdvar , pv_r1d=pvar, & 229 & ktime=ktime, kstart=kstart, kcount=kcount ) 273 SUBROUTINE iom_get_r_0d( knumfl, cdvar, pvar ) 274 INTEGER , INTENT(in ) :: knumfl ! Identifier of the file 275 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 276 REAL(wp) , INTENT( out) :: pvar ! read field 277 ! 278 IF( knumfl > 0 .AND. iom_varid( knumfl, cdvar ) > 0 ) CALL fliogetv( knumfl, cdvar, pvar ) 279 END SUBROUTINE iom_get_r_0d 280 281 SUBROUTINE iom_get_r_1d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount ) 282 INTEGER , INTENT(in ) :: knumfl ! Identifier of the file 283 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 284 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 285 REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field 286 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 287 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 288 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 289 ! 290 IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom , cdvar , pv_r1d=pvar, & 291 & ktime=ktime, kstart=kstart, kcount=kcount ) 230 292 END SUBROUTINE iom_get_r_1d 231 SUBROUTINE iom_get_r_2d( knumfl, kdom , cdvar , pvar , & 232 & ktime, kstart, kcount ) 233 INTEGER,INTENT(in) :: knumfl 234 INTEGER,INTENT(in) :: kdom 235 CHARACTER(len=*),INTENT(in) :: cdvar 236 REAL(wp),INTENT(out),DIMENSION(:,:) :: pvar 237 INTEGER,INTENT(in),OPTIONAL :: ktime 238 INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kstart 239 INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kcount 240 ! 241 CHARACTER(LEN=100) :: clinfo ! info character 242 ! 243 clinfo = 'iom_get_r_2d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 244 IF( PRESENT(kstart) ) THEN 245 IF ( size(kstart) /= 2 ) CALL ctl_stop(trim(clinfo), 'kstart must be a 2 element vector') 246 ENDIF 247 IF( PRESENT(kcount) ) THEN 248 IF ( size(kcount) /= 2 ) CALL ctl_stop(trim(clinfo), 'kcount must be a 2 element vector') 249 ENDIF 250 IF ( knumfl > 0 ) CALL iom_u_getv( knumfl, kdom , cdvar , pv_r2d=pvar, & 251 & ktime=ktime, kstart=kstart, kcount=kcount ) 293 294 SUBROUTINE iom_get_r_2d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount ) 295 INTEGER , INTENT(in ) :: knumfl ! Identifier of the file 296 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 297 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 298 REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 299 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 300 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 301 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 302 ! 303 IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom , cdvar , pv_r2d=pvar, & 304 & ktime=ktime, kstart=kstart, kcount=kcount ) 252 305 END SUBROUTINE iom_get_r_2d 253 SUBROUTINE iom_get_r_3d( knumfl, kdom , cdvar , pvar , & 254 & ktime, kstart, kcount ) 255 INTEGER,INTENT(in) :: knumfl 256 INTEGER,INTENT(in) :: kdom 257 CHARACTER(len=*),INTENT(in) :: cdvar 258 REAL(wp),INTENT(out),DIMENSION(:,:,:) :: pvar 259 INTEGER,INTENT(in),OPTIONAL :: ktime 260 INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kstart 261 INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kcount 262 ! 263 CHARACTER(LEN=100) :: clinfo ! info character 264 ! 265 clinfo = 'iom_get_r_3d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 266 IF ( PRESENT(kstart) ) THEN 267 IF ( size(kstart) /= 3 ) CALL ctl_stop(trim(clinfo), 'kstart must be a 3 element vector') 268 ENDIF 269 IF ( PRESENT(kcount) ) THEN 270 IF ( size(kcount) /= 3 ) CALL ctl_stop(trim(clinfo), 'kcount must be a 3 element vector') 271 ENDIF 272 IF ( knumfl > 0 ) CALL iom_u_getv( knumfl, kdom , cdvar , pv_r3d=pvar, & 273 & ktime=ktime, kstart=kstart, kcount=kcount ) 306 307 SUBROUTINE iom_get_r_3d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount ) 308 INTEGER , INTENT(in ) :: knumfl ! Identifier of the file 309 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 310 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 311 REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 312 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 313 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 314 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 315 ! 316 IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom , cdvar , pv_r3d=pvar, & 317 & ktime=ktime, kstart=kstart, kcount=kcount ) 274 318 END SUBROUTINE iom_get_r_3d 275 319 !!---------------------------------------------------------------------- 276 320 277 278 SUBROUTINE iom_u_getv( knumfl, kdom , cdvar , & 279 & pv_r1d, pv_r2d, pv_r3d, & 280 & ktime , kstart, kcount ) 321 SUBROUTINE iom_get_123d( knumfl, kdom , cdvar , & 322 & pv_r1d, pv_r2d, pv_r3d, & 323 & ktime , kstart, kcount ) 281 324 !!----------------------------------------------------------------------- 282 !! *** ROUTINE iom_ u_getv***325 !! *** ROUTINE iom_get_123d *** 283 326 !! 284 327 !! ** Purpose : read a 1D/2D/3D variable 285 328 !! 286 !! ** Method : read ONE time step at each CALL 287 !! 329 !! ** Method : read ONE record at each CALL 288 330 !!----------------------------------------------------------------------- 289 INTEGER , INTENT(in) :: knumfl ! Identifier of the file290 INTEGER , INTENT(in) :: kdom ! Type of domain to be read291 CHARACTER(len=*) , INTENT(in) :: cdvar ! Name of the variable292 REAL(wp), DIMENSION(:) , INTENT(out), OPTIONAL :: pv_r1d ! read field (1D case)293 REAL(wp), DIMENSION(:,:) , INTENT(out), OPTIONAL :: pv_r2d ! read field (2D case)294 REAL(wp), DIMENSION(:,:,:) , INTENT(out), OPTIONAL :: pv_r3d ! read field (3D case)295 INTEGER , INTENT(in), OPTIONAL :: ktime ! record number296 INTEGER , DIMENSION(:) , INTENT(in), OPTIONAL :: kstart ! start position of the reading in each axis297 INTEGER , DIMENSION(:) , INTENT(in), OPTIONAL :: kcount ! number of points to be read in each axis298 299 INTEGER :: jl! loop on number of dimension300 INTEGER :: idom, &! type of domain301 & idvar, &! id of the variable302 & inbdim, &! number of dimensions of the variable303 & idmspc, &! number of spatial dimensions304 & itime, &! record number305 & istop! temporary value of nstop306 INTEGER, DIMENSION(jpmax_dims) :: istart, &! starting point to read for each axis307 & icnt, &! number of value to read along each axis308 & idimsz! size of the dimensions of the variable309 REAL(wp) :: zscf, zofs! sacle_factor and add_offset310 INTEGER :: itmp! temporary integer311 CHARACTER(LEN=100) :: clinfo! info character331 INTEGER , INTENT(in ) :: knumfl ! Identifier of the file 332 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 333 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 334 REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 335 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 336 REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 337 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 338 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 339 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 340 ! 341 INTEGER :: jl ! loop on number of dimension 342 INTEGER :: idom, & ! type of domain 343 & idvar, & ! id of the variable 344 & inbdim, & ! number of dimensions of the variable 345 & idmspc, & ! number of spatial dimensions 346 & itime, & ! record number 347 & istop ! temporary value of nstop 348 INTEGER, DIMENSION(jpmax_dims) :: istart, & ! starting point to read for each axis 349 & icnt, & ! number of value to read along each axis 350 & idimsz ! size of the dimensions of the variable 351 REAL(wp) :: zscf, zofs ! sacle_factor and add_offset 352 INTEGER :: itmp ! temporary integer 353 CHARACTER(LEN=100) :: clinfo ! info character 312 354 !--------------------------------------------------------------------- 313 clinfo = 'iom_u_getv, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 355 ! 356 clinfo = ' iom_get_123d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 314 357 ! local definition of the domain ? 315 358 idom = kdom 316 359 ! check kcount and kstart optionals parameters... 317 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) &360 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) & 318 361 CALL ctl_stop( trim(clinfo), 'kcount present needs kstart present' ) 319 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) &362 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) & 320 363 CALL ctl_stop( trim(clinfo), 'kstart present needs kcount present' ) 321 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown )&364 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) & 322 365 CALL ctl_stop( trim(clinfo), 'kstart present needs kdom = jpdom_unknown' ) 323 366 324 367 ! Search for the variable in the data base (eventually actualize data) 325 !-326 368 istop = nstop 327 369 idvar = iom_varid( knumfl, cdvar ) 328 370 ! 329 IF 371 IF( idvar > 0 ) THEN 330 372 ! to write iom_file(knumfl)%dimsz in a shorter way ! 331 373 idimsz(:) = iom_file(knumfl)%dimsz(:, idvar) 332 inbdim = iom_file(knumfl)%ndims(idvar)! number of dimensions in the file 333 idmspc = inbdim ! number of spatial dimensions in the file 334 IF( iom_file(knumfl)%luld(idvar) ) idmspc = inbdim - 1 335 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions', & 336 & 'this case is not coded...') 337 ! Identify the domain in case of jpdom_local definition 338 !- 339 IF( idom == jpdom_local ) THEN 374 inbdim = iom_file(knumfl)%ndims(idvar) ! number of dimensions in the file 375 idmspc = inbdim ! number of spatial dimensions in the file 376 IF( iom_file(knumfl)%luld(idvar) ) idmspc = inbdim - 1 377 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), & 378 & 'the file has more than 3 spatial dimensions this case is not coded...' ) 379 IF( idom == jpdom_local ) THEN ! Identify the domain in case of jpdom_local definition 340 380 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN 341 381 idom = jpdom_local_full … … 348 388 ENDIF 349 389 ENDIF 350 390 ! 351 391 ! definition of istart and icnt 352 ! -392 ! 353 393 ! initializations 354 394 istart(:) = 1 355 icnt (:) = 1395 icnt (:) = 1 356 396 itime = 1 357 397 IF( PRESENT(ktime) ) itime = ktime … … 383 423 CASE (2) 384 424 ! data is 2d array (+ maybe a temporal dimension) 385 IF 425 IF( PRESENT(kstart) ) THEN 386 426 istart(1:3) = (/ kstart(1:2), itime /) 387 427 icnt(1:2) = kcount(1:2) … … 404 444 ENDIF 405 445 CASE DEFAULT 406 IF 407 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...', &408 & 'As the size of the z dimension is 1 and as we try to read the first re acord, ',&409 & 'we accept this case even if there is a possible mix-up between z and time dimension ...')410 IF 446 IF( itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 447 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...', & 448 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 449 & 'we accept this case even if there is a possible mix-up between z and time dimension' ) 450 IF( PRESENT(kstart) ) THEN 411 451 istart(1:2) = kstart(1:2) 412 452 icnt(1:2) = kcount(1:2) … … 428 468 ENDIF 429 469 ELSE 430 CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 2D array,', &431 & 'we do not accept data with more than 2 spatial dimension',&432 & 'Use ncwa -a to suppress the unnecessary dimensions')470 CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 2D array,', & 471 & 'we do not accept data with more than 2 spatial dimension', & 472 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 433 473 ENDIF 434 474 END SELECT 435 475 ELSEIF( PRESENT(pv_r3d) ) THEN 436 476 SELECT CASE (idmspc) 437 CASE (1)438 CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension',&439 & 'it is impossible to read a 3d array from this file...')440 CASE (2)441 CALL ctl_stop( trim(clinfo), 'the file has only 2 spatial dimension',&442 & 'it is impossible to read a 3d array from this file...')443 CASE (3)477 CASE( 1 ) 478 CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension', & 479 & 'it is impossible to read a 3d array from this file...' ) 480 CASE( 2 ) 481 CALL ctl_stop( trim(clinfo), 'the file has only 2 spatial dimension', & 482 & 'it is impossible to read a 3d array from this file...' ) 483 CASE( 3 ) 444 484 ! data is 3d array (+ maybe a temporal dimension) 445 485 IF( PRESENT(kstart) ) THEN … … 469 509 ENDIF 470 510 CASE DEFAULT 471 CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 3D array,', &472 & 'we do not accept data with more than 3 spatial dimension', &473 & 'Use ncwa -a to suppress the unnecessary dimensions' )511 CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 3D array,', & 512 & 'we do not accept data with more than 3 spatial dimension', & 513 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 474 514 END SELECT 475 515 ENDIF … … 491 531 itmp = size(pv_r1d) 492 532 WRITE(ctmp1,*) 'size(pv_r1d): ', itmp, ' /= icnt(1): ', icnt(1) 493 IF( itmp /= icnt(1) ) CALL ctl_stop( trim(clinfo), ctmp1 )533 IF( itmp /= icnt(1) ) CALL ctl_stop( trim(clinfo), ctmp1 ) 494 534 ELSEIF( PRESENT(pv_r2d) ) THEN 495 535 DO jl = 1, 2 … … 501 541 WRITE(ctmp1,*) 'size(pv_r2d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 502 542 ENDIF 503 IF( itmp /= icnt(jl) ) CALL ctl_stop( trim(clinfo), ctmp1 )543 IF( itmp /= icnt(jl) ) CALL ctl_stop( trim(clinfo), ctmp1 ) 504 544 END DO 505 545 ELSEIF( PRESENT(pv_r3d) ) THEN … … 512 552 WRITE(ctmp1,*) 'size(pv_r3d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 513 553 ENDIF 514 IF( itmp /= icnt(jl) ) CALL ctl_stop( trim(clinfo), ctmp1 )554 IF( itmp /= icnt(jl) ) CALL ctl_stop( trim(clinfo), ctmp1 ) 515 555 END DO 516 556 ENDIF … … 520 560 !- 521 561 IF( istop == nstop) THEN ! no additional errors until this point... 522 !523 istop = nstop524 562 ! 525 563 zscf = iom_file(knumfl)%scf(idvar) ! scale factor … … 529 567 CALL fliogetv( knumfl, cdvar, pv_r1d(:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 530 568 !--- Apply scale_factor and offset 531 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf532 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs569 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 570 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 533 571 ELSEIF( PRESENT(pv_r2d) ) THEN 534 572 IF( idom /= jpdom_unknown ) THEN 535 573 CALL fliogetv( knumfl, cdvar, pv_r2d(nldi:nlei,nldj:nlej), start=istart(1:inbdim), count=icnt(1:inbdim) ) 536 574 !--- Apply scale_factor and offset 537 IF (zscf /= 1.) pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) * zscf 538 IF (zofs /= 0.) pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) + zofs 575 !CDIR NOUNROLL 576 IF( zscf /= 1.) pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) * zscf 577 !CDIR NOUNROLL 578 IF( zofs /= 0.) pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) + zofs 539 579 !--- Fill the overlap areas and extra hallows (mpp) 540 580 CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') … … 542 582 CALL fliogetv( knumfl, cdvar, pv_r2d(:,:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 543 583 !--- Apply scale_factor and offset 544 IF (zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 545 IF (zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 584 !CDIR COLLAPSE 585 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 586 !CDIR COLLAPSE 587 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 546 588 ENDIF 547 589 ELSEIF( PRESENT(pv_r3d) ) THEN 548 590 IF( idom /= jpdom_unknown ) THEN 549 CALL fliogetv( knumfl, cdvar, pv_r3d(nldi:nlei,nldj:nlej,:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 591 CALL fliogetv( knumfl, cdvar, pv_r3d(nldi:nlei,nldj:nlej,:), start=istart(1:inbdim), & 592 & count=icnt (1:inbdim) ) 550 593 !--- Apply scale_factor and offset 551 IF( zscf /= 1. ) pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) * zscf 552 IF( zofs /= 0. ) pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) + zofs 594 !CDIR NOUNROLL 595 IF( zscf /= 1. ) pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) * zscf 596 !CDIR NOUNROLL 597 IF( zofs /= 0. ) pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) + zofs 553 598 !--- Fill the overlap areas and extra hallows (mpp) 554 599 IF( icnt(3) == jpk ) CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) ! this if could be removed with the new lbc_lnk ... … … 556 601 CALL fliogetv( knumfl, cdvar, pv_r3d(:,:,:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 557 602 !--- Apply scale_factor and offset 558 IF (zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 559 IF (zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 603 !CDIR COLLAPSE 604 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 605 !CDIR COLLAPSE 606 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 560 607 ENDIF 561 608 ENDIF 562 609 ! 563 IF( istop == nstop .AND. lwp ) &564 & WRITE(numout,*) 'read '//trim(cdvar)//' in '//trim(iom_file(knumfl)%name)//' ok'610 IF( istop == nstop .AND. lwp ) & 611 WRITE(numout,*) ' read '//trim(cdvar)//' in '//trim(iom_file(knumfl)%name)//' ok' 565 612 ENDIF 566 613 ! 567 END SUBROUTINE iom_ u_getv614 END SUBROUTINE iom_get_123d 568 615 569 616 570 617 SUBROUTINE iom_gettime( knumfl, cdvar, ptime ) 571 !!-------------------------------------------------------------------- 572 !! *** SUBROUTINE iom_close *** 573 !! 574 !! ** Purpose : read the time axis cdvar in the file 575 !! 576 !! ** Method : 577 !! 578 !!-------------------------------------------------------------------- 579 INTEGER , INTENT(in) :: knumfl ! Identifier of the file to be closed 580 CHARACTER(len=*) , INTENT(in) :: cdvar ! time axis name 581 REAL(wp), DIMENSION(:), INTENT(out) :: ptime ! the time axis 582 583 INTEGER :: idvar ! id of the variable 584 CHARACTER(LEN=100) :: clinfo ! info character 585 !--------------------------------------------------------------------- 586 clinfo = 'iom_gettime, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 587 idvar = iom_varid( knumfl, cdvar ) 588 ! 589 ptime(:) = 0. ! default definition 590 IF ( idvar > 0 ) THEN 591 IF ( iom_file(knumfl)%ndims(idvar) == 1 ) THEN 592 IF ( iom_file(knumfl)%luld(idvar) ) THEN 593 IF ( iom_file(knumfl)%dimsz(1,idvar) == size(ptime) ) THEN 594 CALL fliogetv( knumfl, cdvar, ptime(:), start=(/ 1 /), & 595 & count=(/ iom_file(knumfl)%dimsz(1,idvar) /) ) 596 ELSE 597 WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(knumfl)%dimsz(1,idvar) 598 CALL ctl_stop( trim(clinfo), trim(ctmp1) ) 599 ENDIF 600 ELSE 601 CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' ) 602 ENDIF 603 ELSE 604 CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' ) 605 ENDIF 606 ELSE 607 CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(knumfl)%name ) 608 ENDIF 609 618 !!-------------------------------------------------------------------- 619 !! *** SUBROUTINE iom_gettime *** 620 !! 621 !! ** Purpose : read the time axis cdvar in the file 622 !!-------------------------------------------------------------------- 623 INTEGER , INTENT(in ) :: knumfl ! file Identifier 624 CHARACTER(len=*) , INTENT(in ) :: cdvar ! time axis name 625 REAL(wp), DIMENSION(:), INTENT( out) :: ptime ! the time axis 626 ! 627 INTEGER :: idvar ! id of the variable 628 CHARACTER(LEN=100) :: clinfo ! info character 629 !--------------------------------------------------------------------- 630 ! 631 clinfo = 'iom_gettime, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 632 idvar = iom_varid( knumfl, cdvar ) 633 ! 634 ptime(:) = 0. ! default definition 635 IF( idvar > 0 ) THEN 636 IF( iom_file(knumfl)%ndims(idvar) == 1 ) THEN 637 IF( iom_file(knumfl)%luld(idvar) ) THEN 638 IF( iom_file(knumfl)%dimsz(1,idvar) == size(ptime) ) THEN 639 CALL fliogetv( knumfl, cdvar, ptime(:), start=(/ 1 /), & 640 & count=(/ iom_file(knumfl)%dimsz(1,idvar) /) ) 641 ELSE 642 WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(knumfl)%dimsz(1,idvar) 643 CALL ctl_stop( trim(clinfo), trim(ctmp1) ) 644 ENDIF 645 ELSE 646 CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' ) 647 ENDIF 648 ELSE 649 CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' ) 650 ENDIF 651 ELSE 652 CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(knumfl)%name ) 653 ENDIF 654 ! 610 655 END SUBROUTINE iom_gettime 611 656 612 657 613 614 658 FUNCTION iom_varid ( knumfl, cdvar, kdimsz ) 615 !!----------------------------------------------------------------------- 616 !! *** FUNCTION iom_varid *** 617 !! 618 !! ** Purpose : get the id of a variable in a file (return 0 if not found) 619 !! 620 !! ** Method : ??? 621 !! 622 !!----------------------------------------------------------------------- 623 INTEGER , INTENT(in) :: knumfl ! file Identifier 624 CHARACTER(len=*) , INTENT(in) :: cdvar ! name of the variable 625 INTEGER, DIMENSION(:), INTENT(out), OPTIONAL :: kdimsz ! size of the dimensions 626 ! 627 INTEGER :: iom_varid, idvar, i_nvd, ji 628 INTEGER, DIMENSION(jpmax_dims) :: idimid 629 LOGICAL :: ll_fnd 630 CHARACTER(LEN=100) :: clinfo ! info character 631 !!----------------------------------------------------------------------- 632 clinfo = 'iom_varid, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 633 iom_varid = 0 ! default definition 634 IF ( PRESENT(kdimsz) ) kdimsz(:) = 0 ! default definition 635 ! 636 IF ( knumfl > 0 ) THEN 637 IF( iom_file(knumfl)%iopen == 0 ) THEN 638 CALL ctl_stop( trim(clinfo), 'the file is not open' ) 639 ELSE 640 ! 641 ll_fnd = .FALSE. 642 idvar = 0 643 ! 644 DO WHILE ( .NOT.ll_fnd .AND. idvar < iom_file(knumfl)%nvars ) 645 idvar = idvar + 1 646 ll_fnd = ( TRIM(cdvar) == TRIM(iom_file(knumfl)%cn_var(idvar)) ) 647 END DO 648 ! 649 IF( .NOT.ll_fnd ) THEN 650 idvar = idvar + 1 651 IF( idvar <= jpmax_vars ) THEN 652 CALL flioinqv( knumfl, cdvar, ll_fnd, nb_dims = i_nvd ) 653 IF( ll_fnd ) THEN 654 IF( i_nvd <= jpmax_dims ) THEN 655 iom_file(knumfl)%nvars = idvar 656 iom_file(knumfl)%cn_var(idvar) = trim(cdvar) 657 iom_file(knumfl)%ndims(idvar) = i_nvd 658 CALL flioinqv( knumfl, cdvar, ll_fnd, & 659 & len_dims = iom_file(knumfl)%dimsz(1:i_nvd,idvar), & 660 & id_dims = idimid(1:i_nvd) ) 661 DO ji = 1, i_nvd 662 IF ( idimid(ji) == iom_file(knumfl)%iduld ) iom_file(knumfl)%luld(idvar) = .TRUE. 663 END DO 664 !---------- 665 !---------- Deal with scale_factor and offset 666 CALL flioinqa( knumfl, cdvar, 'scale_factor', ll_fnd ) 667 IF (ll_fnd) THEN 668 CALL fliogeta( knumfl, cdvar, 'scale_factor', iom_file(knumfl)%scf(idvar) ) 669 ELSE 670 iom_file(knumfl)%scf(idvar) = 1. 671 END IF 672 CALL flioinqa( knumfl, cdvar, 'offset', ll_fnd ) 673 IF( ll_fnd ) THEN 674 CALL fliogeta( knumfl, cdvar, 'offset', iom_file(knumfl)%ofs(idvar) ) 675 ELSE 676 iom_file(knumfl)%ofs(idvar) = 0. 677 END IF 678 ! 679 iom_varid = idvar 680 IF ( PRESENT(kdimsz) ) THEN 681 IF ( i_nvd == size(kdimsz) ) THEN 682 kdimsz(:) = iom_file(knumfl)%dimsz(1:i_nvd,idvar) 683 ELSE 684 WRITE(ctmp1,*) i_nvd, size(kdimsz) 685 CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) ) 686 ENDIF 687 ENDIF 688 ELSE 689 CALL ctl_stop( trim(clinfo), 'Too many dimensions in the file '//iom_file(knumfl)%name, & 690 & 'increase the parameter jpmax_vars') 691 ENDIF 692 ELSE 693 CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// & 694 & ' is not found in the file '//trim(iom_file(knumfl)%name) ) 695 ENDIF 696 ELSE 697 CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(knumfl)%name, & 698 & 'increase the parameter jpmax_vars') 699 ENDIF 700 ELSE 701 iom_varid = idvar 702 IF ( PRESENT(kdimsz) ) THEN 703 i_nvd = iom_file(knumfl)%ndims(idvar) 704 IF ( i_nvd == size(kdimsz) ) THEN 705 kdimsz(:) = iom_file(knumfl)%dimsz(1:i_nvd,idvar) 706 ELSE 707 WRITE(ctmp1,*) i_nvd, size(kdimsz) 708 CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) ) 709 ENDIF 710 ENDIF 711 ENDIF 712 ENDIF 713 ENDIF 714 659 !!----------------------------------------------------------------------- 660 !! *** FUNCTION iom_varid *** 661 !! 662 !! ** Purpose : get the id of a variable in a file (return 0 if not found) 663 !!----------------------------------------------------------------------- 664 INTEGER , INTENT(in ) :: knumfl ! file Identifier 665 CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable 666 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions 667 ! 668 INTEGER :: ji ! dummy loop index 669 INTEGER :: iom_varid, idvar, i_nvd 670 INTEGER, DIMENSION(jpmax_dims) :: idimid 671 LOGICAL :: ll_fnd 672 CHARACTER(LEN=100) :: clinfo ! info character 673 !!----------------------------------------------------------------------- 674 clinfo = 'iom_varid, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 675 iom_varid = 0 ! default definition 676 IF( PRESENT(kdimsz) ) kdimsz(:) = 0 ! default definition 677 ! 678 IF( knumfl > 0 ) THEN 679 IF( iom_file(knumfl)%iopen == 0 ) THEN 680 CALL ctl_stop( trim(clinfo), 'the file is not open' ) 681 ELSE 682 ll_fnd = .FALSE. 683 idvar = 0 684 ! 685 DO WHILE ( .NOT.ll_fnd .AND. idvar < iom_file(knumfl)%nvars ) 686 idvar = idvar + 1 687 ll_fnd = ( TRIM(cdvar) == TRIM(iom_file(knumfl)%cn_var(idvar)) ) 688 END DO 689 ! 690 IF( .NOT.ll_fnd ) THEN 691 idvar = idvar + 1 692 IF( idvar <= jpmax_vars ) THEN 693 CALL flioinqv( knumfl, cdvar, ll_fnd, nb_dims = i_nvd ) 694 IF( ll_fnd ) THEN 695 IF( i_nvd <= jpmax_dims ) THEN 696 iom_file(knumfl)%nvars = idvar 697 iom_file(knumfl)%cn_var(idvar) = trim(cdvar) 698 iom_file(knumfl)%ndims(idvar) = i_nvd 699 CALL flioinqv( knumfl, cdvar, ll_fnd, & 700 & len_dims = iom_file(knumfl)%dimsz(1:i_nvd,idvar), & 701 & id_dims = idimid(1:i_nvd) ) 702 DO ji = 1, i_nvd 703 IF( idimid(ji) == iom_file(knumfl)%iduld ) iom_file(knumfl)%luld(idvar) = .TRUE. 704 END DO 705 !---------- 706 !---------- Deal with scale_factor and offset 707 CALL flioinqa( knumfl, cdvar, 'scale_factor', ll_fnd ) 708 IF( ll_fnd) THEN 709 CALL fliogeta( knumfl, cdvar, 'scale_factor', iom_file(knumfl)%scf(idvar) ) 710 ELSE 711 iom_file(knumfl)%scf(idvar) = 1. 712 END IF 713 CALL flioinqa( knumfl, cdvar, 'offset', ll_fnd ) 714 IF( ll_fnd ) THEN 715 CALL fliogeta( knumfl, cdvar, 'offset', iom_file(knumfl)%ofs(idvar) ) 716 ELSE 717 iom_file(knumfl)%ofs(idvar) = 0. 718 END IF 719 ! 720 iom_varid = idvar 721 IF( PRESENT(kdimsz) ) THEN 722 IF( i_nvd == size(kdimsz) ) THEN 723 kdimsz(:) = iom_file(knumfl)%dimsz(1:i_nvd,idvar) 724 ELSE 725 WRITE(ctmp1,*) i_nvd, size(kdimsz) 726 CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) ) 727 ENDIF 728 ENDIF 729 ELSE 730 CALL ctl_stop( trim(clinfo), 'Too many dimensions in the file '//iom_file(knumfl)%name, & 731 & 'increase the parameter jpmax_vars') 732 ENDIF 733 !!$ ELSE 734 !!$ CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// & 735 !!$ & ' is not found in the file '//trim(iom_file(knumfl)%name) ) 736 ENDIF 737 ELSE 738 CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(knumfl)%name, & 739 & 'increase the parameter jpmax_vars') 740 ENDIF 741 ELSE 742 iom_varid = idvar 743 IF( PRESENT(kdimsz) ) THEN 744 i_nvd = iom_file(knumfl)%ndims(idvar) 745 IF( i_nvd == size(kdimsz) ) THEN 746 kdimsz(:) = iom_file(knumfl)%dimsz(1:i_nvd,idvar) 747 ELSE 748 WRITE(ctmp1,*) i_nvd, size(kdimsz) 749 CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) ) 750 ENDIF 751 ENDIF 752 ENDIF 753 ENDIF 754 ENDIF 755 ! 715 756 END FUNCTION iom_varid 716 757 717 718 FUNCTION iom_get_gblatt( knumfl, kinfonum ) 719 !!----------------------------------------------------------------------- 720 !! *** FUNCTION iom_get_gblatt *** 758 !!---------------------------------------------------------------------- 759 !! INTERFACE iom_rstput 760 !!---------------------------------------------------------------------- 761 SUBROUTINE iom_rstput_0d( kt, kwrite, knumfl, cdvar, pvar ) 762 INTEGER , INTENT(in) :: kt ! ocean time-step 763 INTEGER , INTENT(in) :: kwrite ! writing time-step 764 INTEGER , INTENT(in) :: knumfl ! Identifier of the file 765 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 766 REAL(wp) , INTENT(in) :: pvar ! read field 767 IF( knumfl > 0 ) CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r0d = pvar ) 768 END SUBROUTINE iom_rstput_0d 769 770 SUBROUTINE iom_rstput_1d( kt, kwrite, knumfl, cdvar, pvar ) 771 INTEGER , INTENT(in) :: kt ! ocean time-step 772 INTEGER , INTENT(in) :: kwrite ! writing time-step 773 INTEGER , INTENT(in) :: knumfl ! Identifier of the file 774 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 775 REAL(wp) , INTENT(in), DIMENSION( jpk) :: pvar ! read field 776 IF( knumfl > 0 ) CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r1d = pvar ) 777 END SUBROUTINE iom_rstput_1d 778 779 SUBROUTINE iom_rstput_2d( kt, kwrite, knumfl, cdvar, pvar ) 780 INTEGER , INTENT(in) :: kt ! ocean time-step 781 INTEGER , INTENT(in) :: kwrite ! writing time-step 782 INTEGER , INTENT(in) :: knumfl ! Identifier of the file 783 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 784 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj ) :: pvar ! read field 785 IF( knumfl > 0 ) CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r2d = pvar ) 786 END SUBROUTINE iom_rstput_2d 787 788 SUBROUTINE iom_rstput_3d( kt, kwrite, knumfl, cdvar, pvar ) 789 INTEGER , INTENT(in) :: kt ! ocean time-step 790 INTEGER , INTENT(in) :: kwrite ! writing time-step 791 INTEGER , INTENT(in) :: knumfl ! Identifier of the file 792 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 793 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvar ! read field 794 IF( knumfl > 0 ) CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r3d = pvar ) 795 END SUBROUTINE iom_rstput_3d 796 !!---------------------------------------------------------------------- 797 798 SUBROUTINE iom_rstput_0123d( kt, kwrite, knumfl, cdvar , & 799 & pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 800 !!-------------------------------------------------------------------- 801 !! *** SUBROUTINE iom_rstput *** 721 802 !! 722 !! ** Purpose : ??? 723 !! 724 !! ** Method : ??? 725 !! 726 !!----------------------------------------------------------------------- 727 INTEGER,INTENT(in) :: knumfl 728 INTEGER, intent(in) :: kinfonum 729 ! 730 CHARACTER(LEN=10) :: clinfo 731 REAL(wp) :: iom_get_gblatt 732 !!----------------------------------------------------------------------- 733 734 WRITE(clinfo,*) kinfonum 735 clinfo = 'info'//trim(adjustl(clinfo)) 736 CALL fliogeta (knumfl, "?", clinfo, iom_get_gblatt) 737 738 END FUNCTION iom_get_gblatt 739 803 !! ** Purpose : read the time axis cdvar in the file 804 !!-------------------------------------------------------------------- 805 INTEGER , INTENT(in) :: kt ! ocean time-step 806 INTEGER , INTENT(in) :: kwrite ! writing time-step 807 INTEGER , INTENT(in) :: knumfl ! Identifier of the file 808 CHARACTER(len=*) , INTENT(in) :: cdvar ! time axis name 809 REAL(wp) , INTENT(in), OPTIONAL :: pv_r0d ! read field 810 REAL(wp), DIMENSION(:) , INTENT(in), OPTIONAL :: pv_r1d ! read field 811 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: pv_r2d ! read field 812 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: pv_r3d ! read field 813 ! 814 INTEGER :: idims, idvar 815 INTEGER :: ix1, ix2, iy1, iy2 816 INTEGER, DIMENSION(4) :: idimsz, idimid 817 CHARACTER(LEN=100) :: clinfo ! info character 818 !--------------------------------------------------------------------- 819 ! 820 clinfo = ' iom_rstput_0123d, file: '//TRIM(iom_file(knumfl)%name)//', var: '//TRIM(cdvar) 821 822 ! define dimension variables if it is not already done 823 ! ========================== 824 IF( iom_file(knumfl)%nvars == 0 ) THEN 825 ! define the dimension variables if it is not already done 826 CALL fliodefv( knumfl,'nav_lon', (/1,2/), v_t=flio_r4 , axis='X', & 827 & long_name="Longitude", units="degrees_east" ) 828 CALL fliodefv( knumfl,'nav_lat', (/1,2/), v_t=flio_r4 , axis='Y', & 829 & long_name="Latitude", units="degrees_north" ) 830 CALL fliodefv( knumfl,'nav_lev', (/3/) , v_t=flio_i4 , axis='Z', & 831 & long_name="Model levels",units="model_levels") 832 CALL fliodefv( knumfl,'time_counter', (/4/), v_t=flio_r4, axis='T', & 833 & long_name="Time axis", units='seconds since 0001-01-01 00:00:00' ) 834 ! update informations structure related the dimension variable we just added... 835 iom_file(knumfl)%nvars = 4 836 iom_file(knumfl)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 837 iom_file(knumfl)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /) 838 iom_file(knumfl)%cn_var(4) = 'time_counter' 839 iom_file(knumfl)%ndims(1:4) = (/ 2, 2, 1, 1 /) 840 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 841 ENDIF 842 843 ! define the data if it is not already done 844 ! =============== 845 idvar = iom_varid( knumfl, cdvar ) 846 IF( idvar <= 0 ) THEN 847 ! variable definition 848 IF( PRESENT(pv_r0d) ) THEN ; idims = 0 849 ELSEIF( PRESENT(pv_r1d) ) THEN ; idims = 2 ; idimid(1:idims) = (/ 3,4/) 850 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/) 851 ELSEIF( PRESENT(pv_r3d) ) THEN ; idims = 4 ; idimid(1:idims) = (/1,2,3,4/) 852 ENDIF 853 IF( PRESENT(pv_r0d) ) THEN ; CALL fliodefv (knumfl, cdvar , v_t = flio_r8) 854 ELSE ; CALL fliodefv (knumfl, cdvar, idimid(1:idims), v_t = flio_r8) 855 ENDIF 856 ! update informations structure related the new variable we want to add... 857 idvar = iom_file(knumfl)%nvars + 1 858 iom_file(knumfl)%nvars = idvar 859 iom_file(knumfl)%cn_var(idvar) = TRIM(cdvar) 860 iom_file(knumfl)%scf(idvar) = 1. 861 iom_file(knumfl)%ofs(idvar) = 0. 862 iom_file(knumfl)%ndims(idvar) = idims 863 IF( .NOT. PRESENT(pv_r0d) ) THEN 864 iom_file(knumfl)%luld(idvar) = .TRUE. 865 CALL flioinqf( knumfl, ln_dim = idimsz ) 866 iom_file(knumfl)%dimsz(1:idims-1,idvar) = idimsz(idimid(1:idims-1)) 867 ENDIF 868 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok' 869 ENDIF 870 871 ! time step kwrite : write the variable 872 IF( kt == kwrite ) THEN 873 ! on what kind of domain must the data be written? 874 IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 875 idimsz(1:2) = iom_file(knumfl)%dimsz(1:2,idvar) 876 IF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN 877 ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 878 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN 879 ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 880 ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN 881 ix1 = 1 ; ix2 = jpi ; iy1 = 1 ; iy2 = jpj 882 ELSE 883 CALL ctl_stop( 'iom_rstput_0123d: should have been an impossible case...' ) 884 ENDIF 885 886 ! write dimension variables if it is not already done 887 ! ============= 888 IF( iom_file(knumfl)%dimsz(1, 1) == 0 ) THEN 889 CALL flioputv( knumfl, 'nav_lon' , glamt(ix1:ix2, iy1:iy2) ) 890 CALL flioputv( knumfl, 'nav_lat' , gphit(ix1:ix2, iy1:iy2) ) 891 CALL flioputv( knumfl, 'nav_lev' , gdept_0 ) 892 CALL flioputv( knumfl, 'time_counter', kt ) ! +++ WRONG VALUE: to be improved but not really useful... 893 ! update informations structure related the dimension variable 894 iom_file(knumfl)%dimsz(1:2, 1) = idimsz(1:2) 895 iom_file(knumfl)%dimsz(1:2, 2) = idimsz(1:2) 896 iom_file(knumfl)%dimsz(1, 3:4) = (/idimsz(3), 1/) 897 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 898 ENDIF 899 ENDIF 900 901 ! write the data 902 ! ============= 903 IF( PRESENT(pv_r0d) ) THEN ; CALL flioputv( knumfl, cdvar, pv_r0d ) 904 ELSEIF( PRESENT(pv_r1d) ) THEN ; CALL flioputv( knumfl, cdvar, pv_r1d( :) ) 905 ELSEIF( PRESENT(pv_r2d) ) THEN ; CALL flioputv( knumfl, cdvar, pv_r2d(ix1:ix2, iy1:iy2 ) ) 906 ELSEIF( PRESENT(pv_r3d) ) THEN ; CALL flioputv( knumfl, cdvar, pv_r3d(ix1:ix2, iy1:iy2, :) ) 907 ENDIF 908 ! add 1 to the size of the temporal dimension (not really useful...) 909 IF( iom_file(knumfl)%luld(idvar) ) iom_file(knumfl)%dimsz(iom_file(knumfl)%ndims(idvar), idvar) & 910 & = iom_file(knumfl)%dimsz(iom_file(knumfl)%ndims(idvar), idvar) + 1 911 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok' 912 ENDIF 913 ! 914 END SUBROUTINE iom_rstput_0123d 915 740 916 !!====================================================================== 741 917 END MODULE iom
Note: See TracChangeset
for help on using the changeset viewer.
