From d88909864c32a8d686431d39bd9884b2c33d69a5 Mon Sep 17 00:00:00 2001 From: Seth Underwood Date: Tue, 1 Nov 2016 08:52:18 -0400 Subject: [PATCH] Write manifest in JSON format The manifest file is now written in JSON #21 --- diag_manager/diag_manifest.F90 | 278 ++++++++++++++++++++++++++++----- 1 file changed, 241 insertions(+), 37 deletions(-) diff --git a/diag_manager/diag_manifest.F90 b/diag_manager/diag_manifest.F90 index 50d90f4d7c..330cf32a43 100644 --- a/diag_manager/diag_manifest.F90 +++ b/diag_manager/diag_manifest.F90 @@ -13,6 +13,12 @@ MODULE diag_manifest_mod & mpp_root_pe USE fms_mod, ONLY: error_mesg,& & WARNING + + IMPLICIT NONE + + INTERFACE ASSIGNMENT(=) + MODULE PROCEDURE manifest_field_type_assign + END INTERFACE ASSIGNMENT(=) ! Some type to hold data for manifest TYPE manifest_field_type @@ -24,17 +30,31 @@ MODULE diag_manifest_mod INTEGER :: nDim !< number of dimensions END TYPE manifest_field_type + TYPE manifest_fields_type + INTEGER :: num_1d = 0 + INTEGER :: num_2d = 0 + INTEGER :: num_3d = 0 + INTEGER :: num_4d = 0 + TYPE(manifest_field_type), DIMENSION(:), ALLOCATABLE :: fields_1d + TYPE(manifest_field_type), DIMENSION(:), ALLOCATABLE :: fields_2d + TYPE(manifest_field_type), DIMENSION(:), ALLOCATABLE :: fields_3d + TYPE(manifest_field_type), DIMENSION(:), ALLOCATABLE :: fields_4d + END TYPE manifest_fields_type + PRIVATE PUBLIC :: write_diag_manifest CONTAINS + ! PUBLIC routines SUBROUTINE write_diag_manifest(file) INTEGER, INTENT(in) :: file - INTEGER :: i, j, o INTEGER :: file_unit, ios - TYPE(manifest_field_type) :: maniField + INTEGER :: num_static, num_temporal + TYPE(manifest_fields_type) :: static_fields + TYPE(manifest_fields_type) :: temporal_fields + CHARACTER(len=128) :: maniFileName ! This entire routine should only be called by the rootPE @@ -46,44 +66,228 @@ SUBROUTINE write_diag_manifest(file) ! tile/ensemble as all should have the same data. maniFileName = TRIM(files(file)%name)//".mfst" - ! Open the file for writing - ! - ! Not using mpp_open, as this routine forces to only write from the root - ! PE, and each root PE should have its own set of files to write. - OPEN(UNIT=file_unit, FILE=TRIM(maniFileName), ACCESS='SEQUENTIAL', FORM='FORMATTED',& - & ACTION='WRITE', POSITION='REWIND', IOSTAT=ios) - IF ( ios .NE. 0 ) THEN - CALL error_mesg('diag_manifest_mod::write_diag_manifest',& - & 'Unable to open file "'//TRIM(maniFileName)//'". No manifest file will be created.',& - & WARNING) + static_fields = get_diagnostic_fields(file, static=.TRUE.) + temporal_fields = get_diagnostic_fields(file, static=.FALSE.) + + ! Get the number of fields to write to manifest file + num_static = static_fields%num_1d + static_fields%num_2d + static_fields%num_3d + static_fields%num_4d + num_temporal = temporal_fields%num_1d + temporal_fields%num_2d + temporal_fields%num_3d + temporal_fields%num_4d + + ! Open the file for writing, but only if we have something to write + IF ( num_static + num_temporal .GT. 0 ) THEN + ! Not using mpp_open, as this routine forces to only write from the root + ! PE, and each root PE should have its own set of files to write. + OPEN(UNIT=file_unit, FILE=TRIM(maniFileName), ACCESS='SEQUENTIAL', FORM='FORMATTED',& + & ACTION='WRITE', POSITION='REWIND', IOSTAT=ios) + IF ( ios .NE. 0 ) THEN + CALL error_mesg('diag_manifest_mod::write_diag_manifest',& + & 'Unable to open file "'//TRIM(maniFileName)//'". No manifest file will be created.',& + & WARNING) + ELSE + ! Open JSON + write(file_unit,'(A1)') '{' + ! Fill in other data + CALL write_manifest(file_unit, static_fields, static=.TRUE.) + CALL write_manifest(file_unit, temporal_fields, static=.FALSE.) + ! Close JSON + write(file_unit,'(A1)') '}' + !!WRITE(file_unit,'(A128,",",A128,",",A128,",",A50,",",i2,",",i2)') maniField%output_name, manifield%module_name,& + !! & maniField%input_name, maniField%time_method, maniField%packing, maniField%nDim + ! Close the file + CLOSE(file_unit) + END IF + END IF + END IF + END SUBROUTINE write_diag_manifest + + ! PRIVATE routines + SUBROUTINE manifest_field_type_assign(lhs,rhs) + TYPE(manifest_field_type), INTENT(out) :: lhs + TYPE(manifest_field_type), INTENT(in) :: rhs + + lhs%output_name = rhs%output_name + lhs%module_name = rhs%module_name + lhs%input_name = rhs%input_name + lhs%time_method = rhs%time_method + lhs%packing = rhs%packing + lhs%nDim = rhs%nDim + END SUBROUTINE manifest_field_type_assign + + SUBROUTINE write_fields(unit, fields) + INTEGER, INTENT(in) :: unit + TYPE(manifest_field_type), DIMENSION(:), INTENT(in) :: fields + + INTEGER :: i + CHARACTER(LEN=*), PARAMETER :: FMT_FLD = "(12X,'""',A,'""',': {')" + CHARACTER(LEN=*), PARAMETER :: FMT_MOF = "(16X,'""model_field"":','""',A,'"",')" + CHARACTER(LEN=*), PARAMETER :: FMT_MOD = "(16X,'""module"":','""',A,'"",')" + CHARACTER(LEN=*), PARAMETER :: FMT_PAK = "(16X,'""packing"":',I1,',')" + CHARACTER(LEN=*), PARAMETER :: FMT_TAV = "(16X,'""time_averaging"":','""',A,'""')" + + DO i=1, SIZE(fields) + WRITE (unit,FMT_FLD) TRIM(fields(i)%output_name) + WRITE (unit,FMT_MOF) TRIM(fields(i)%input_name) + WRITE (unit,FMT_MOD) TRIM(fields(i)%module_name) + WRITE (unit,FMT_PAK) fields(i)%packing + WRITE (unit,FMT_TAV) TRIM(fields(i)%time_method) + IF ( i.EQ.SIZE(fields) ) THEN + WRITE (unit,'(12X,A1)') '}' ELSE - ! Loop over all fields in file - DO j = 1, files(file)%num_fields - o = files(file)%fields(j) ! Position of this field in output_fields array - i = output_fields(o)%input_field ! Position of the input fields associated with this output_field + WRITE (unit,'(12X,A2)') '},' + END IF + END DO + END SUBROUTINE write_fields + + SUBROUTINE write_manifest(unit, fields, static) + INTEGER, INTENT(in) :: unit + TYPE(manifest_fields_type), INTENT(in) :: fields + LOGICAL, INTENT(in) :: static + + CHARACTER(len=*), PARAMETER :: FMT_DIM = "(8X,'""',A2,'""',': {')" + CHARACTER(len=*), PARAMETER :: FMT_STA = "(4X,'""',A6,'""',': {')" + CHARACTER(len=*), PARAMETER :: FMT_TEM = "(4X,'""',A8,'""',': {')" + + ! Static / Temporal + IF ( static ) THEN + WRITE (unit,FMT_STA) 'Static' + ELSE + WRITE (unit,FMT_TEM) 'Temporal' + END IF + + ! 1D fields + WRITE (unit,FMT_DIM) '1D' + CALL write_fields(unit, fields%fields_1d(1:fields%num_1d)) + WRITE (unit,'(8X,A2)') '},' + + ! 2D fields + WRITE (unit,FMT_DIM) '2D' + CALL write_fields(unit, fields%fields_2d(1:fields%num_2d)) + WRITE (unit,'(8X,A2)') '},' + + ! 3D fields + WRITE (unit,FMT_DIM) '3D' + CALL write_fields(unit, fields%fields_3d(1:fields%num_3d)) + WRITE (unit,'(8X,A2)') '},' + + ! 4D fields + WRITE (unit,FMT_DIM) '4D' + CALL write_fields(unit, fields%fields_4d(1:fields%num_4d)) + WRITE (unit,'(8X,A1)') '}' + + ! Static / Temporal + IF ( static ) THEN + WRITE (unit,'(4X,A2)') '},' + ELSE + WRITE (unit,'(4X,A1)') '}' + END IF + END SUBROUTINE write_manifest + + TYPE(manifest_fields_type) FUNCTION get_diagnostic_fields(file, static) + INTEGER, INTENT(in) :: file !< diagnostic file, as defined by diag_manager_mod + LOGICAL, INTENT(in) :: static !< Indicates if looking for static or non-static + ! fields. .TRUE. indicates looking only for + ! static files. .FALSE. indicates looking only + ! for non-static fields. + + INTEGER :: i, j, o + INTEGER :: istat + TYPE(manifest_field_type) :: maniField + CHARACTER(len=128) :: maniFileName + + maniFileName = TRIM(files(file)%name)//".mfst" + + DO j=1, files(file)%num_fields + o = files(file)%fields(j) ! Position of this field in output_fields array + IF ( output_fields(o)%written_once .AND. (static.EQV.output_fields(o)%static) ) THEN + ! output field was written to file, and is static/non-static, whichever was requested + ! Gather the information to record it. + i = output_fields(o)%input_field ! Position of the input fields associated with this output_field - ! this is information I currently know we want to save, and where it is: - maniField%output_name = output_fields(o)%output_name - maniField%module_name = input_fields(i)%module_name - maniField%input_name = input_fields(i)%field_name - IF ( output_fields(o)%static ) THEN - maniField%time_method = ".false." - ELSE - maniField%time_method = output_fields(o)%time_method + ! this is information I currently know we want to save, and where it is: + maniField%output_name = output_fields(o)%output_name + maniField%module_name = input_fields(i)%module_name + maniField%input_name = input_fields(i)%field_name + IF ( output_fields(o)%static ) THEN + ! Static fields MUST have a time_method of .false. + maniField%time_method = ".false." + ELSE + maniField%time_method = output_fields(o)%time_method + END IF + maniField%packing = output_fields(o)%pack + maniField%nDim = output_fields(o)%num_axes + + ! Now that we have the information about the field, add to type based on dimensions of field + SELECT CASE (maniField%nDim) + CASE (1) + get_diagnostic_fields%num_1d = get_diagnostic_fields%num_1d + 1 + IF ( .NOT.ALLOCATED(get_diagnostic_fields%fields_1d) ) THEN + ! Allocate to the max number of fields + ALLOCATE(get_diagnostic_fields%fields_1d(files(file)%num_fields), STAT=istat) + IF ( istat.NE.0 ) THEN + CALL error_mesg('diag_manifest_mod::get_diagnostic_fields',& + & 'Unable to allocate 1d array for manifest file "'//TRIM(maniFileName)//'". Manifest incomplete.',& + & WARNING) + ! Resetting count to 0 to keep from writing out + get_diagnostic_fields%num_1d = 0 + CYCLE + END IF + END IF + IF ( ALLOCATED(get_diagnostic_fields%fields_1d) ) THEN + get_diagnostic_fields%fields_1d(get_diagnostic_fields%num_1d) = maniField + END IF + CASE (2) + get_diagnostic_fields%num_2d = get_diagnostic_fields%num_2d + 1 + IF ( .NOT.ALLOCATED(get_diagnostic_fields%fields_2d) ) THEN + ! Allocate to the max number of fields + ALLOCATE(get_diagnostic_fields%fields_2d(files(file)%num_fields), STAT=istat) + IF ( istat.NE.0 ) THEN + CALL error_mesg('diag_manifest_mod::get_diagnostic_fields',& + & 'Unable to allocate 2d array for manifest file "'//TRIM(maniFileName)//'". Manifest incomplete.',& + & WARNING) + ! Resetting count to 0 to keep from writing out + get_diagnostic_fields%num_2d = 0 + CYCLE + END IF + END IF + IF ( ALLOCATED(get_diagnostic_fields%fields_2d) ) THEN + get_diagnostic_fields%fields_2d(get_diagnostic_fields%num_2d) = maniField + END IF + CASE (3) + get_diagnostic_fields%num_3d = get_diagnostic_fields%num_3d + 1 + IF ( .NOT.ALLOCATED(get_diagnostic_fields%fields_3d) ) THEN + ! Allocate to the max number of fields + ALLOCATE(get_diagnostic_fields%fields_3d(files(file)%num_fields), STAT=istat) + IF ( istat.NE.0 ) THEN + CALL error_mesg('diag_manifest_mod::get_diagnostic_fields',& + & 'Unable to allocate 3d array for manifest file "'//TRIM(maniFileName)//'". Manifest incomplete.',& + & WARNING) + ! Resetting count to 0 to keep from writing out + get_diagnostic_fields%num_3d = 0 + CYCLE + END IF END IF - maniField%packing = output_fields(o)%pack - maniField%nDim = output_fields(o)%num_axes - ! Write the data to the manifest file. Cannot use mpp_write as it expects - ! time dependent fields - IF ( output_fields(o)%written_once ) THEN - WRITE(file_unit,'(A128,",",A128,",",A128,",",A50,",",i2,",",i2)') maniField%output_name, manifield%module_name,& - & maniField%input_name, maniField%time_method, maniField%packing, maniField%nDim + IF ( ALLOCATED(get_diagnostic_fields%fields_3d) ) THEN + get_diagnostic_fields%fields_3d(get_diagnostic_fields%num_3d) = maniField END IF - END DO - - ! Close the file - CLOSE(file_unit) + CASE (4) + get_diagnostic_fields%num_4d = get_diagnostic_fields%num_4d + 1 + IF ( .NOT.ALLOCATED(get_diagnostic_fields%fields_4d) ) THEN + ! Allocate to the max number of fields + ALLOCATE(get_diagnostic_fields%fields_4d(files(file)%num_fields), STAT=istat) + IF ( istat.NE.0 ) THEN + CALL error_mesg('diag_manifest_mod::get_diagnostic_fields',& + & 'Unable to allocate 4d array for manifest file "'//TRIM(maniFileName)//'". Manifest incomplete.',& + & WARNING) + ! Resetting count to 0 to keep from writing out + get_diagnostic_fields%num_4d = 0 + CYCLE + END IF + END IF + IF ( ALLOCATED(get_diagnostic_fields%fields_4d) ) THEN + get_diagnostic_fields%fields_4d(get_diagnostic_fields%num_4d) = maniField + END IF + END SELECT END IF - END IF - END SUBROUTINE write_diag_manifest + END DO + END FUNCTION get_diagnostic_fields END MODULE diag_manifest_mod