mo_io.f90
MODULE mo_io
USE mo_netCDF
USE mo_parameters, ONLY: jpg3xf
5: USE mo_io_tables, ONLY: ng3xl, ng3xp
USE mo_mpi
IMPLICIT NONE
10: TYPE (netCDF_file), SAVE :: ini_ozon
TYPE (netCDF_file), SAVE :: ini_field
TYPE (netCDF_file), SAVE :: sstnc0, sstnc1, sstnc2
TYPE (netCDF_file), SAVE :: header
TYPE (netCDF_file), SAVE :: ini_surf
15: TYPE (netCDF_file), SAVE :: ini_spec
TYPE (netCDF_file), SAVE :: restart(31:38)
REAL, ALLOCATABLE :: vlon(:), vlat(:)
20: ! IO variables
INTEGER, PARAMETER :: IO_READ = 1, IO_WRITE = 2
INTEGER :: IO_file_id, IO_var_id, IO_dim_id
25: INTEGER :: IO_dims(4)
INTEGER :: IO_timestep = -1
! time variables
30: INTEGER :: forecast_date, forecast_time, verification_date, verification_time
! dimension ids - available for reading data ...
INTEGER :: nc_ngl_id, nc_nhgl_id
35: INTEGER :: nc_nlon_id, nc_nlp2_id
INTEGER :: nc_nlev_id, nc_nlevp1_id
INTEGER :: nc_nsp_id
INTEGER :: nc_nvclev_id, nc_nhtrac_id, nc_nmp1_id
INTEGER :: nc_n2_id, nc_nswitches_id
40: INTEGER :: nswitches
INTEGER :: io_ng3xl_id(jpg3xf)
CONTAINS
45: SUBROUTINE IO_close(info)
USE mo_exception
USE mo_start_dataset, ONLY: ldebugio
50: IMPLICIT NONE
TYPE (netCDF_file), INTENT(INOUT) :: info
INTEGER :: status
55:
IF (p_pe == p_io) THEN
status = NF_CLOSE(info%nc_file_id)
60: IF (ldebugio) WRITE(nerr,*) 'IO_close: ', info%nc_file_name
IF (status == NF_NOERR) THEN
info%nc_opened = .FALSE.
ELSE
65: CALL message ('IO_close', NF_STRERROR(status));
CALL finish ('IO_close', 'Run terminated.')
END IF
END IF
70:
END SUBROUTINE IO_close
SUBROUTINE IO_open(filename, info, mode)
75: USE mo_exception
USE mo_start_dataset, ONLY: ldebugio
IMPLICIT NONE
80: INTEGER, INTENT(IN) :: mode
CHARACTER (*), INTENT(IN) :: filename
TYPE (netCDF_file), INTENT(INOUT) :: info
INTEGER :: status, ncmode
85:
IF (p_pe == p_io) THEN
IF (info%nc_opened) THEN
WRITE(nerr,*) 'IO_open: file ',info%nc_file_name,' already open'
CALL finish ('IO_open', 'Run terminated.')
90: END IF
IF (mode == IO_READ) THEN
ncmode = NF_NOWRITE
ELSE IF (mode == IO_WRITE) THEN
95: ncmode = NF_WRITE
ELSE
CALL message ('IO_open', 'unexpected mode');
CALL finish ('IO_open', 'Run terminated.')
END IF
100:
info%nc_file_name = filename
IF (mode == IO_READ) THEN
status = NF_OPEN (filename, ncmode, info%nc_file_id)
105: ELSE
status = NF_CREATE (filename, NF_CLOBBER, info%nc_file_id)
ENDIF
IF (ldebugio) WRITE(nerr,*) 'IO_open: ', filename, mode, ncmode, &
110: info%nc_file_id
IF (status == NF_NOERR) THEN
info%nc_opened = .TRUE.
ELSE
115: CALL message ('IO_open', filename);
CALL message ('IO_open', NF_STRERROR(status));
CALL finish ('IO_open', 'Run terminated.')
ENDIF
120: END IF
END SUBROUTINE IO_open
SUBROUTINE IO_open_unit(unit, info, mode)
125:
USE mo_exception
IMPLICIT NONE
130: INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(IN) :: mode
TYPE (netCDF_file), INTENT(INOUT) :: info
CHARACTER (13) :: filename
135: IF (p_pe == p_io) THEN
IF (info%nc_opened) THEN
WRITE(nerr,*) 'IO_open_unit: unit ',unit,' allready assigned to ', &
info%nc_file_name
CALL finish ('IO_open_unit', 'Run terminated.')
140: END IF
IF (unit < 10 .OR. unit > 99) THEN
WRITE(nerr,*) 'IO_open_unit: unit ',unit,' out of range'
CALL finish ('IO_open_unit', 'Run terminated.')
145: END IF
END IF
WRITE (filename,'(A5,I2.2)') 'unit.',unit
150: CALL IO_open(filename, info, mode)
END SUBROUTINE IO_open_unit
SUBROUTINE IO_write_header(io_unit, io_list, io_list2)
155:
USE mo_exception
USE mo_doctor
USE mo_control
USE mo_diagnostics
160: USE mo_year
USE mo_start_dataset
USE mo_tracer, ONLY: nhtrac
USE mo_filename, ONLY: yomdn
USE mo_memory_f
165: USE mo_memory_gl
USE mo_memory_g1a
USE mo_memory_g2a
USE mo_memory_g3a
USE mo_memory_g3b
170: USE mo_linked_list, ONLY: list_element
USE mo_netCDF
IMPLICIT NONE
175: INTEGER, INTENT(IN) :: io_unit
INTEGER :: ifcday, ifcsec
REAL :: zfcsec
INTEGER :: jx
CHARACTER (8) :: yname
180: INTEGER :: ndim
CHARACTER (10) :: io_name
INTEGER :: io_vlat_id, io_vlon_id, io_vcta_id, io_vctb_id
INTEGER :: io_nswitches_id
185: REAL, ALLOCATABLE :: restart_diag(:)
TYPE (list_element), POINTER :: io_list
TYPE (list_element), OPTIONAL, POINTER :: io_list2
IF (p_pe == p_io) THEN
190:
header = restart(io_unit)
IO_file_id = header%nc_file_id
CALL IO_DEF_DIM (IO_file_id, "ngl", ngl, nc_ngl_id);
195: CALL IO_DEF_DIM (IO_file_id, "nhgl", nhgl, nc_nhgl_id);
CALL IO_DEF_DIM (IO_file_id, "nlon", nlon, nc_nlon_id);
CALL IO_DEF_DIM (IO_file_id, "nlp2", nlp2, nc_nlp2_id);
CALL IO_DEF_DIM (IO_file_id, "nlev", nlev, nc_nlev_id);
CALL IO_DEF_DIM (IO_file_id, "nlevp1", nlevp1, nc_nlevp1_id);
200: CALL IO_DEF_DIM (IO_file_id, "nsp", nsp, nc_nsp_id);
CALL IO_DEF_DIM (IO_file_id, "nvclev", nvclev, nc_nvclev_id);
CALL IO_DEF_DIM (IO_file_id, "n2", 2, nc_n2_id);
CALL IO_DEF_DIM (IO_file_id, "nmp1", nmp1, nc_nmp1_id);
CALL IO_DEF_DIM (IO_file_id, "nhtrac", nhtrac, nc_nhtrac_id);
205:
nswitches = 53
CALL IO_DEF_DIM (IO_file_id, "nswitches", nswitches, nc_nswitches_id);
IF (ng3xp>0 .AND. io_unit==nhg3) THEN
210: DO jx = 1, ng3xp
WRITE(yname,'(a5,i2.2)' ) 'ng3xl',jx
CALL IO_DEF_DIM (IO_file_id, yname, ng3xl(jx), io_ng3xl_id(jx));
ENDDO
ENDIF
215:
WRITE(header%nc_file_type,'(A,I2,A)') &
'Restart history file (unit:',io_unit,')'
header%nc_binary_source = 'IEEE'
220: header%nc_creation_program = yomdn
header%nc_creation_user = ylabel7(2:)
header%nc_creation_date = ylabel6(2:)
! CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'title', header%nc_title)
225: CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'file_type', header%nc_file_type)
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'source_type', header%nc_binary_source)
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'history', header%nc_creation_program)
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'user', header%nc_creation_user)
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'created', header%nc_creation_date)
230:
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_1', ylabel1(2:))
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_2', ylabel2(2:))
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_3', ylabel3(2:))
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_4', ylabel4(2:))
235: CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_5', ylabel5(2:))
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_6', ylabel6(2:))
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_7', ylabel7(2:))
CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_8', ylabel8(2:))
240: ! put data reference times
forecast_time = isec2hms(ntbase)
forecast_date = ic2ymd(ncbase)
245: zfcsec = (nstep+1)*twodt*0.5+ntbase
ifcday = INT(zfcsec/(24*3600))
ifcsec = INT(MOD(zfcsec,REAL(24*3600)))
verification_time = isec2hms(ifcsec)
250: verification_date = ic2ymd(ncbase+ifcday)
CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'fdate', forecast_date)
CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'ftime', forecast_time)
CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'vdate', verification_date)
255: CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'vtime', verification_time)
! put spherical truncations ...
CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'spherical_truncation_n', nn)
260: CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'spherical_truncation_m', nm)
CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'spherical_truncation_k', nk)
! put nstep
265: CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'nstep', nstep)
! put timestep
CALL IO_PUT_ATT_DOUBLE (IO_file_id, NF_GLOBAL, 'timestep', dtime)
270:
! tracer
! IF (nhtrac == 0) THEN
! CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'tracer_definition', 'No tracer available')
275: ! ELSE
! CALL IO_PUT_ATT_TEXT (IO_file_id, NF_GLOBAL, 'tracer_definition', 'Tracer available')
! END IF
IF (ng3xp>0 .AND. io_unit==nhg3) THEN
CALL IO_PUT_ATT_INT (IO_file_id, NF_GLOBAL, 'ng3xp', ng3xp)
280: END IF
IO_dims(1) = nc_ngl_id
CALL IO_DEF_VAR (IO_file_id, "lat", NF_DOUBLE, 1, IO_dims, io_vlat_id)
IO_dims(1) = nc_nlon_id
285: CALL IO_DEF_VAR (IO_file_id, "lon", NF_DOUBLE, 1, IO_dims, io_vlon_id)
IO_dims(1) = nc_nvclev_id
CALL IO_DEF_VAR (IO_file_id, "vct_a", NF_DOUBLE, 1, IO_dims, io_vcta_id)
IO_dims(1) = nc_nvclev_id
CALL IO_DEF_VAR (IO_file_id, "vct_b", NF_DOUBLE, 1, IO_dims, io_vctb_id)
290: IO_dims(1) = nc_nswitches_id
CALL IO_DEF_VAR (IO_file_id, "switches", NF_DOUBLE, 1, IO_dims, io_nswitches_id)
DO WHILE (ASSOCIATED(io_list))
295: IF (io_list%field%info%restart) THEN
ndim = io_list%field%info%ndim
io_name = io_list%field%info%name
CALL IO_DEF_VAR (IO_file_id, io_name, NF_DOUBLE, ndim, &
io_list%field%info%IO_var_indx, &
300: io_list%field%info%IO_var_id)
END IF
io_list => io_list%next_list_element
ENDDO
305: IF (PRESENT(io_list2)) THEN
DO WHILE (ASSOCIATED(io_list2))
IF (io_list2%field%info%restart) THEN
ndim = io_list2%field%info%ndim
io_name = io_list2%field%info%name
310: CALL IO_DEF_VAR (IO_file_id, io_name, NF_DOUBLE, ndim, &
io_list2%field%info%IO_var_indx, &
io_list2%field%info%IO_var_id)
END IF
io_list2 => io_list2%next_list_element
315: ENDDO
END IF
CALL IO_ENDDEF(IO_file_id)
320: CALL IO_PUT_VAR_DOUBLE (IO_file_id, io_vlat_id, vlat)
CALL IO_PUT_VAR_DOUBLE (IO_file_id, io_vlon_id, vlon)
CALL IO_PUT_VAR_DOUBLE (IO_file_id, io_vcta_id, vct(1:nvclev))
CALL IO_PUT_VAR_DOUBLE (IO_file_id, io_vctb_id, vct(nvclev+1:2*nvclev))
325: nswitches = 53
ALLOCATE (restart_diag(nswitches))
restart_diag( 1) = cdiats
restart_diag( 2) = cdiatd
330: restart_diag( 3) = cdiawd
restart_diag( 4) = gpe0
restart_diag( 5) = gke0
restart_diag( 6) = gqm0
restart_diag( 7) = gts0
335: restart_diag( 8) = gtd0
restart_diag( 9) = gws0
restart_diag(10) = gwd0
restart_diag(11) = gsn0
restart_diag(12) = dsrad0
340: restart_diag(13) = dtrad0
restart_diag(14) = dsrads
restart_diag(15) = dtrads
restart_diag(16) = dvdis
restart_diag(17) = dhfs
345: restart_diag(18) = devap
restart_diag(19) = dcvfr
restart_diag(20) = dcvqac
restart_diag(21) = dcvmoi
restart_diag(22) = dcvgr
350: restart_diag(23) = dcvgs
restart_diag(24) = dcvms
restart_diag(25) = dcver
restart_diag(26) = dcves
restart_diag(27) = dlsgr
355: restart_diag(28) = dlsgs
restart_diag(29) = dlsms
restart_diag(30) = dlser
restart_diag(31) = dlses
restart_diag(32) = dssrad
360: restart_diag(33) = dstrad
restart_diag(34) = dshfl
restart_diag(35) = dsdtfl
restart_diag(36) = dslsr
restart_diag(37) = dslss
365: restart_diag(38) = dscvr
restart_diag(39) = dscvs
restart_diag(40) = dsevw
restart_diag(41) = dsevi
restart_diag(42) = dsdwfl
370: restart_diag(43) = dssnmt
restart_diag(44) = ddctfl
restart_diag(45) = ddcwfl
restart_diag(46) = dsros
restart_diag(47) = dsrod
375: restart_diag(48) = dadcon
restart_diag(49) = dgwdis
restart_diag(50) = dsevdw
restart_diag(51) = dsevcw
restart_diag(52) = dstsml
380: restart_diag(53) = dstdml
CALL IO_PUT_VAR_DOUBLE (IO_file_id, io_nswitches_id, restart_diag)
DEALLOCATE (restart_diag)
END IF
385:
END SUBROUTINE IO_write_header
SUBROUTINE IO_read_header()
390: USE mo_exception
USE mo_doctor
USE mo_start_dataset, ONLY: ldebugio
IMPLICIT NONE
395:
IF (p_pe == p_io) THEN
IO_file_id = header%nc_file_id
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'file_type', &
header%nc_file_type)
400:
IF (header%nc_file_type(1:3) /= "Ini" &
.AND. header%nc_file_type(1:3) /= "Res") THEN
CALL message ('IO_read_header', header%nc_file_type);
CALL message ('IO_read_header', 'No ECHAM initial or restart file.');
405: CALL finish ('IO_read_header', 'Run terminated.')
ENDIF
! CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'title', header%nc_title)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'file_type', header%nc_file_type)
410: CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'source_type', header%nc_binary_source)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'history', header%nc_creation_program)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'user', header%nc_creation_user)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'created', header%nc_creation_date)
415: ylabel1(:) = ' '; ylabel2(:) = ' '; ylabel3(:) = ' '; ylabel4(:) = ' ';
ylabel5(:) = ' '; ylabel6(:) = ' '; ylabel7(:) = ' '; ylabel8(:) = ' ';
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_1', ylabel1)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_2', ylabel2)
420: CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_3', ylabel3)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_4', ylabel4)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_5', ylabel5)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_6', ylabel6)
CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_7', ylabel7)
425: CALL IO_GET_ATT_TEXT (IO_file_id, NF_GLOBAL, 'label_8', ylabel8)
IF (ldebugio) THEN
WRITE (nerr, *)
IF (header%nc_file_type(1:12) == "Initial file") THEN
430: WRITE (nerr, '(6(1x,a,/))') ylabel1, ylabel2, ylabel3, ylabel4, &
ylabel5, ylabel6
ELSE
WRITE (nerr, '(8(1x,a,/))') ylabel1, ylabel2, ylabel3, ylabel4, &
ylabel5, ylabel6, ylabel7, ylabel8
435: ENDIF
WRITE (nerr, *)
END IF
END IF
CALL p_bcast (ylabel1, p_io)
440: CALL p_bcast (ylabel2, p_io)
CALL p_bcast (ylabel3, p_io)
CALL p_bcast (ylabel4, p_io)
CALL p_bcast (ylabel5, p_io)
CALL p_bcast (ylabel6, p_io)
445: CALL p_bcast (ylabel7, p_io)
CALL p_bcast (ylabel8, p_io)
END SUBROUTINE IO_read_header
450: SUBROUTINE IO_init
USE mo_exception
USE mo_doctor
USE mo_control
455: USE mo_diagnostics
USE mo_start_dataset, ONLY: lres, nhf1, nisp, nstep, ly365
USE mo_year, ONLY: iymd2c, cd2dat, ihms2sec
USE m_alloc_mods, ONLY: alloc_mods ! module subroutine
USE mo_tracer, ONLY: nhtrac
460:
IMPLICIT NONE
REAL, ALLOCATABLE :: restart_diag(:)
465: INTEGER :: idv
INTEGER :: nswitches
INTEGER :: icd, id, im, iy, ih, imin
CHARACTER (3) :: month(12) = (/ 'jan', 'feb', 'mar', 'apr', 'may', 'jun', &
470: 'jul', 'aug', 'sep', 'oct', 'nov', 'dec' /)
sstnc0%nc_opened = .FALSE.
sstnc1%nc_opened = .FALSE.
sstnc2%nc_opened = .FALSE.
475: header%nc_opened = .FALSE.
ini_surf%nc_opened = .FALSE.
ini_spec%nc_opened = .FALSE.
ini_ozon%nc_opened = .FALSE.
ini_field%nc_opened = .FALSE.
480: restart(31:38)%nc_opened = .FALSE.
IF (lres) THEN
idv = nhf1
ELSE
485: idv = nisp
ENDIF
CALL IO_open_unit(idv, header, IO_READ)
490: CALL IO_read_header()
IF (p_pe == p_io) THEN
IO_file_id = header%nc_file_id
495: ! get data reference times
CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'fdate', forecast_date)
CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'ftime', forecast_time)
CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'vdate', verification_date)
500: CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'vtime', verification_time)
END IF
CALL p_bcast (forecast_date, p_io)
CALL p_bcast (forecast_time, p_io)
CALL p_bcast (verification_date, p_io)
505: CALL p_bcast (verification_time, p_io)
IF (.NOT. ly365) CALL reset_year
icd = iymd2c(forecast_date)
510: CALL cd2dat (icd, id, im, iy)
ih = forecast_time/10000
imin = (forecast_time -ih*10000)/100
515: IF (p_pe == p_io) THEN
WRITE(nout,'(a,i2.2,a1,i2.2,a,i2,1x,a3,i5,a,i15)') &
' Initial data is at ', ih, ':', imin, &
' on ', id, month(im), iy, ' - century/julian day: ', icd
520:
! get spherical truncations ...
CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'spherical_truncation_n', nn)
CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'spherical_truncation_m', nm)
525: CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'spherical_truncation_k', nk)
! get nstep
IF (lres) CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'nstep', nstep)
530:
! get timestep
IF (lres) CALL IO_GET_ATT_INT (IO_file_id, NF_GLOBAL, 'timestep', IO_timestep)
535: ! inquire for dimensions
CALL IO_INQ_DIMID (IO_file_id, 'ngl', nc_ngl_id)
! IF (lres) CALL IO_INQ_DIMID (IO_file_id, 'nhgl', nc_nhgl_id)
CALL IO_INQ_DIMID (IO_file_id, 'nlon', nc_nlon_id)
540: ! CALL IO_INQ_DIMID (IO_file_id, 'nlp2', nc_nlp2_id)
CALL IO_INQ_DIMID (IO_file_id, 'nlev', nc_nlev_id)
! CALL IO_INQ_DIMID (IO_file_id, 'nlevp1', nc_nlevp1_id)
CALL IO_INQ_DIMID (IO_file_id, 'nsp', nc_nsp_id)
CALL IO_INQ_DIMID (IO_file_id, 'nvclev', nc_nvclev_id)
545: ! CALL IO_INQ_DIMID (IO_file_id, 'n2', nc_n2_id)
IF (lres) CALL IO_INQ_DIMID (IO_file_id, 'nhtrac', nc_nhtrac_id)
! get values for dimensions
550: CALL IO_INQ_DIMLEN (IO_file_id, nc_ngl_id, ngl)
! IF (lres) CALL IO_INQ_DIMLEN (IO_file_id, nc_nhgl_id, nhgl)
CALL IO_INQ_DIMLEN (IO_file_id, nc_nlon_id, nlon)
! CALL IO_INQ_DIMLEN (IO_file_id, nc_nlp2_id, nlp2)
CALL IO_INQ_DIMLEN (IO_file_id, nc_nlev_id, nlev)
555: ! CALL IO_INQ_DIMLEN (IO_file_id, nc_nlevp1_id, nlevp1)
CALL IO_INQ_DIMLEN (IO_file_id, nc_nsp_id, nsp)
CALL IO_INQ_DIMLEN (IO_file_id, nc_nvclev_id, nvclev)
! CALL IO_INQ_DIMLEN (IO_file_id, nc_n2_id, n2)
IF (lres) CALL IO_INQ_DIMLEN (IO_file_id, nc_nhtrac_id, nhtrac)
560: END IF
CALL p_bcast (nn, p_io)
CALL p_bcast (nm, p_io)
CALL p_bcast (nk, p_io)
CALL p_bcast (nstep, p_io)
565: CALL p_bcast (IO_timestep, p_io)
CALL p_bcast (ngl, p_io)
CALL p_bcast (nlon, p_io)
CALL p_bcast (nlev, p_io)
CALL p_bcast (nsp, p_io)
570: CALL p_bcast (nvclev, p_io)
CALL p_bcast (nhtrac, p_io)
! derive dependend dimensions
575: maxrow = ngl
nkp1 = nk+1
nmp1 = nm+1
nnp1 = nn+1
n2mp1 = nmp1+nmp1
580: n4mp1 = n2mp1+n2mp1
nlevp1 = nlev+1
nhgl = ngl/2
nlp2 = nlon+2
n2sp = nsp+nsp
585:
ncbase = iymd2c(forecast_date)
ntbase = ihms2sec(forecast_time)
ncdata = iymd2c(verification_date)
ntdata = ihms2sec(verification_time)
590: ntimst = 1
! read lon
ALLOCATE (vlon(nlon))
595: IF (p_pe == p_io) THEN
CALL IO_INQ_VARID (IO_file_id, 'lon', IO_var_id)
CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, vlon)
END IF
CALL p_bcast (vlon, p_io)
600:
! read lat
ALLOCATE (vlat(ngl))
IF (p_pe == p_io) THEN
605: CALL IO_INQ_VARID (IO_file_id, 'lat', IO_var_id)
CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, vlat)
END IF
CALL p_bcast (vlat, p_io)
610: ! read vct
ALLOCATE (vct(nvclev*2))
IF (p_pe == p_io) THEN
CALL IO_INQ_VARID (IO_file_id, 'vct_a', IO_var_id)
615: CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, vct(1:nvclev))
CALL IO_INQ_VARID (IO_file_id, 'vct_b', IO_var_id)
CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, vct(nvclev+1:2*nvclev))
END IF
620: CALL p_bcast (vct, p_io)
IF (lres) THEN
IF (p_pe == p_io) THEN
625: CALL IO_INQ_DIMID (IO_file_id, 'nswitches', IO_dim_id)
CALL IO_INQ_DIMLEN (IO_file_id, IO_dim_id, nswitches)
END IF
CALL p_bcast (nswitches, p_io)
630: ALLOCATE (restart_diag(nswitches))
IF (p_pe == p_io) THEN
CALL IO_INQ_VARID (IO_file_id, 'switches', IO_var_id)
CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, restart_diag)
END IF
635: CALL p_bcast (restart_diag, p_io)
! Fill module mo_diagnostics
! Information from model switch record. Only secure way is assigning.
640: cdiats = restart_diag( 1)
cdiatd = restart_diag( 2)
cdiawd = restart_diag( 3)
gpe0 = restart_diag( 4)
gke0 = restart_diag( 5)
645: gqm0 = restart_diag( 6)
gts0 = restart_diag( 7)
gtd0 = restart_diag( 8)
gws0 = restart_diag( 9)
gwd0 = restart_diag(10)
650: gsn0 = restart_diag(11)
dsrad0 = restart_diag(12)
dtrad0 = restart_diag(13)
dsrads = restart_diag(14)
dtrads = restart_diag(15)
655: dvdis = restart_diag(16)
dhfs = restart_diag(17)
devap = restart_diag(18)
dcvfr = restart_diag(19)
dcvqac = restart_diag(20)
660: dcvmoi = restart_diag(21)
dcvgr = restart_diag(22)
dcvgs = restart_diag(23)
dcvms = restart_diag(24)
dcver = restart_diag(25)
665: dcves = restart_diag(26)
dlsgr = restart_diag(27)
dlsgs = restart_diag(28)
dlsms = restart_diag(29)
dlser = restart_diag(30)
670: dlses = restart_diag(31)
dssrad = restart_diag(32)
dstrad = restart_diag(33)
dshfl = restart_diag(34)
dsdtfl = restart_diag(35)
675: dslsr = restart_diag(36)
dslss = restart_diag(37)
dscvr = restart_diag(38)
dscvs = restart_diag(39)
dsevw = restart_diag(40)
680: dsevi = restart_diag(41)
dsdwfl = restart_diag(42)
dssnmt = restart_diag(43)
ddctfl = restart_diag(44)
ddcwfl = restart_diag(45)
685: dsros = restart_diag(46)
dsrod = restart_diag(47)
dadcon = restart_diag(48)
dgwdis = restart_diag(49)
dsevdw = restart_diag(50)
690: dsevcw = restart_diag(51)
dstsml = restart_diag(52)
dstdml = restart_diag(53)
icd = iymd2c(verification_date)
695: CALL cd2dat(icd,id,im,iy)
ih = verification_time/10000
imin = (verification_time -ih*10000)/100
700: WRITE(nout,'(a,i2.2,a1,i2.2,a,i2,1x,a3,i5,a,i15)') &
& ' Experiment resumed at ', ih, ':', imin, &
& ' on ', id, month(im), iy, ' - century/julian day: ', icd
DEALLOCATE (restart_diag)
705: END IF
CALL IO_close(header)
! Allocate arrays which depend on nlev
710:
CALL alloc_mods
CALL IO_init_dims
715: END SUBROUTINE IO_init
SUBROUTINE reset_year
IF (header%nc_file_type(1:12) == "Initial file") THEN
forecast_date = forecast_date-10000*(forecast_date/10000-1)
720: verification_date = verification_date-10000*(verification_date/10000-1)
ELSE
forecast_date = forecast_date-10000*(forecast_date/10000-1)
ENDIF
END SUBROUTINE reset_year
725:
INTEGER FUNCTION IO_xl (nxl)
USE mo_start_dataset, ONLY: nhg3
730: IMPLICIT NONE
INTEGER, INTENT(IN) :: nxl
INTEGER :: io_unit
CHARACTER (8) :: yname
735:
io_unit = nhg3
WRITE(yname,'(a5,i2.2)' ) 'ng3xl', nxl
740: IF (p_pe == p_io) THEN
CALL IO_open_unit(io_unit, restart(io_unit), IO_READ)
IO_file_id = restart(io_unit)%nc_file_id
CALL IO_INQ_DIMID (IO_file_id, yname, IO_dim_id)
CALL IO_INQ_DIMLEN (IO_file_id, IO_dim_id, IO_xl)
745: CALL IO_close(restart(io_unit))
END IF
CALL p_bcast (IO_xl, p_io)
END FUNCTION IO_xl
750:
INTEGER FUNCTION IO_ng3xp ()
USE mo_start_dataset, ONLY: nhg3
755: IMPLICIT NONE
INTEGER :: io_unit
io_unit = nhg3
760: IF (p_pe == p_io) THEN
CALL IO_open_unit(io_unit, restart(io_unit), IO_READ)
CALL IO_GET_ATT_INT (restart(io_unit)%nc_file_id, NF_GLOBAL, 'ng3xp', IO_ng3xp)
CALL IO_close(restart(io_unit))
END IF
765: CALL p_bcast (IO_ng3xp, p_io)
END FUNCTION IO_ng3xp
REAL FUNCTION IO_dt ()
770:
IMPLICIT NONE
IF (IO_timestep == -1) CALL finish('IO_dt','timestep was not read')
IO_dt = IO_timestep
775:
END FUNCTION IO_dt
SUBROUTINE IO_write_buffer(io_unit)
780: USE mo_doctor, ONLY: nerr
USE mo_start_dataset
USE mo_memory_f !, ONLY: f
USE mo_memory_gl !, ONLY: gl
USE mo_memory_g1a !, ONLY: g1a
785: USE mo_memory_g2a !, ONLY: g2a
USE mo_memory_g3a !, ONLY: g3a
USE mo_memory_g3b !, ONLY: g3b
USE mo_linked_list, ONLY: list, list_element
790: USE mo_mpi, ONLY: p_pe, p_io
USE mo_decomposition, ONLY: dcg => global_decomposition
USE mo_transpose, ONLY: gather_gp, gather_sa
IMPLICIT NONE
795:
INTEGER, INTENT(IN) :: io_unit
REAL, POINTER :: zout(:,:,:,:), zptr(:,:,:,:)
TYPE (list_element), POINTER :: io_list, io_list2
800: IF (io_unit == nhf1) THEN
io_list => f%first_list_element
ELSE IF (io_unit == nhgl1) THEN
io_list => gl%first_list_element
ELSE IF (io_unit == nhg1) THEN
805: io_list => g1a%first_list_element
ELSE IF (io_unit == nhg2) THEN
io_list => g2a%first_list_element
ELSE IF (io_unit == nhg3) THEN
io_list => g3a%first_list_element
810: io_list2 => g3b%first_list_element
ELSE
WRITE(nerr, *) 'IO_write_buffer: io_unit=',io_unit
CALL finish ('IO_write_buffer', 'io_unit unexpected')
END IF
815:
! Open restart file
CALL IO_open_unit(io_unit, restart(io_unit), IO_WRITE)
820: ! Write data description record
IF (io_unit == nhg3) THEN
CALL IO_write_header(io_unit, io_list, io_list2)
ELSE
825: CALL IO_write_header(io_unit, io_list)
END IF
! Necessary, because IO_write_header changes io_list
! and io_list2
830:
IF (io_unit == nhf1) THEN
io_list => f%first_list_element
ELSE IF (io_unit == nhgl1) THEN
io_list => gl%first_list_element
835: ELSE IF (io_unit == nhg1) THEN
io_list => g1a%first_list_element
ELSE IF (io_unit == nhg2) THEN
io_list => g2a%first_list_element
ELSE IF (io_unit == nhg3) THEN
840: io_list => g3a%first_list_element
io_list2 => g3b%first_list_element
END IF
! Write buffer
845:
IF (p_pe == p_io) THEN
IO_file_id = restart(io_unit)%nc_file_id
ENDIF
850: DO WHILE (ASSOCIATED(io_list))
IF (io_list%field%info%restart) THEN
ALLOCATE(zout(io_list%field%info%gdim_1, &
io_list%field%info%gdim_2, &
io_list%field%info%gdim_3, &
855: io_list%field%info%gdim_4))
zptr => io_list%field%ptr(:,:,:,:)
IF (io_unit == nhf1) THEN
CALL gather_sa (zout, zptr, dcg)
ELSE
860: CALL gather_gp (zout, zptr, dcg)
END IF
IF (p_pe == p_io) THEN
IO_var_id = io_list%field%info%IO_var_id
CALL IO_PUT_VAR_DOUBLE (IO_file_id, IO_var_id, zout)
865: END IF
DEALLOCATE(zout)
END IF
io_list => io_list%next_list_element
870: ENDDO
IF (io_unit == nhg3) THEN
DO WHILE (ASSOCIATED(io_list2))
IF (io_list2%field%info%restart) THEN
875: ALLOCATE(zout(io_list2%field%info%gdim_1, &
io_list2%field%info%gdim_2, &
io_list2%field%info%gdim_3, &
io_list2%field%info%gdim_4))
zptr => io_list2%field%ptr(:,:,:,:)
880: CALL gather_gp (zout, zptr, dcg)
IF (p_pe == p_io) THEN
IO_var_id = io_list2%field%info%IO_var_id
CALL IO_PUT_VAR_DOUBLE (IO_file_id, IO_var_id, zout)
END IF
885: DEALLOCATE (zout)
END IF
io_list2 => io_list2%next_list_element
END DO
END IF
890:
! Close restart file
CALL IO_close(restart(io_unit))
895: END SUBROUTINE IO_write_buffer
SUBROUTINE IO_read_buffer (io_unit, nrec)
USE mo_doctor, ONLY: nerr
900: USE mo_start_dataset
USE mo_memory_f, ONLY: f
USE mo_memory_gl, ONLY: gl
USE mo_memory_g1a, ONLY: g1a
USE mo_memory_g2a, ONLY: g2a
905: USE mo_memory_g3a, ONLY: g3a
USE mo_memory_g3b, ONLY: g3b
USE mo_linked_list, ONLY: list, list_element
USE mo_mpi, ONLY: p_pe, p_io
USE mo_decomposition, ONLY: dcg => global_decomposition
910: USE mo_transpose, ONLY: scatter_gp, scatter_sa
IMPLICIT NONE
INTEGER, INTENT(IN) :: io_unit
915: INTEGER, OPTIONAL, INTENT(IN) :: nrec ! number of records read
REAL, POINTER :: zin(:,:,:,:), zptr(:,:,:,:)
TYPE (list_element), POINTER :: io_list, io_list2
INTEGER :: irec
LOGICAL :: lrec
920:
IF (io_unit == nhf1) THEN
io_list => f%first_list_element
ELSE IF (io_unit == nhgl1) THEN
io_list => gl%first_list_element
925: ELSE IF (io_unit == nhg1) THEN
io_list => g1a%first_list_element
ELSE IF (io_unit == nhg2) THEN
io_list => g2a%first_list_element
ELSE IF (io_unit == nhg3) THEN
930: io_list => g3b%first_list_element
io_list2 => g3a%first_list_element
ELSE
WRITE(nerr, *) 'IO_read_buffer: io_unit=',io_unit
CALL finish ('IO_read_buffer', 'io_unit unexpected')
935: END IF
! Open restart file
CALL IO_open_unit(io_unit, restart(io_unit), IO_READ)
940:
! Read buffer
irec = 0
lrec = .FALSE.
945: IF (PRESENT(nrec)) lrec = .TRUE.
IF (p_pe == p_io) THEN
IO_file_id = restart(io_unit)%nc_file_id
END IF
950: DO WHILE (ASSOCIATED(io_list))
IF (io_list%field%info%restart) THEN
irec = irec + 1
ALLOCATE(zin(io_list%field%info%gdim_1, &
io_list%field%info%gdim_2, &
955: io_list%field%info%gdim_3, &
io_list%field%info%gdim_4))
IF (p_pe == p_io) THEN
CALL IO_INQ_VARID (IO_file_id, io_list%field%info%name, IO_var_id)
CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, zin)
960: END IF
zptr => io_list%field%ptr(:,:,:,:)
IF (io_unit == nhf1) THEN
CALL scatter_sa (zin, zptr, dcg)
ELSE
965: CALL scatter_gp (zin, zptr, dcg)
END IF
DEALLOCATE(zin)
END IF
io_list => io_list%next_list_element
970: IF (lrec) THEN
IF (irec >= nrec) EXIT
END IF
ENDDO
975: IF (io_unit == nhg3) THEN
DO WHILE (ASSOCIATED(io_list2))
IF (io_list2%field%info%restart) THEN
ALLOCATE(zin(io_list2%field%info%gdim_1, &
io_list2%field%info%gdim_2, &
980: io_list2%field%info%gdim_3, &
io_list2%field%info%gdim_4))
IF (p_pe == p_io) THEN
CALL IO_INQ_VARID (IO_file_id, io_list2%field%info%name, &
IO_var_id)
985: CALL IO_GET_VAR_DOUBLE (IO_file_id, IO_var_id, zin)
END IF
zptr => io_list2%field%ptr(:,:,:,:)
CALL scatter_gp (zin, zptr, dcg)
DEALLOCATE(zin)
990: END IF
io_list2 => io_list2%next_list_element
ENDDO
END IF
995: ! Close restart file
CALL IO_close(restart(io_unit))
END SUBROUTINE IO_read_buffer
1000:
END MODULE mo_io
Info Section
uses: m_alloc_mods, mo_control, mo_decomposition, mo_diagnostics, mo_doctor
mo_exception, mo_filename, mo_io_tables, mo_linked_list, mo_memory_f
mo_memory_g1a, mo_memory_g2a, mo_memory_g3a, mo_memory_g3b, mo_memory_gl
mo_mpi, mo_netcdf, mo_parameters, mo_start_dataset, mo_tracer
mo_transpose, mo_year
calls: alloc_mods, cd2dat, finish, gather_gp, gather_sa
io_close, io_def_dim, io_def_var, io_enddef, io_get_att_int
io_get_att_text, io_get_var_double, io_init_dims, io_inq_dimid, io_inq_dimlen
io_inq_varid, io_open, io_open_unit, io_put_att_double, io_put_att_int
io_put_att_text, io_put_var_double, io_read_header, io_write_header, message
p_bcast, reset_year, scatter_gp, scatter_sa
back to top
ECHAM 4 vf90 (C) 1998 Max-Planck-Institut für Meteorologie, Hamburg
Wed Nov 24 01:25:21 CST 1999
HTML derived from FORTRAN source by f2html.pl v0.3 (C) 1997,98 Beroud Jean-Marc.