diff --git a/src/LIB/SURCOUCHE/src/io_write_field.f90 b/src/LIB/SURCOUCHE/src/io_write_field.f90 new file mode 100644 index 0000000000000000000000000000000000000000..c872a5ae0ef2e202daa53b1bc43d6fbf54aa1ce7 --- /dev/null +++ b/src/LIB/SURCOUCHE/src/io_write_field.f90 @@ -0,0 +1,175 @@ +MODULE MODE_IO_WRITE_FIELD +! +USE MODD_IO_ll, ONLY: TOUTBAK +USE MODE_FIELD +USE MODE_FMWRIT +! +IMPLICIT NONE +! +CONTAINS +! +SUBROUTINE IO_WRITE_FIELDLIST(TPOUTPUT,HFIPRI) +! +USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX +! +IMPLICIT NONE +! +TYPE(TOUTBAK),POINTER,INTENT(IN) :: TPOUTPUT !Output structure +CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM +! +INTEGER :: IDX +INTEGER :: IMI +INTEGER :: IRESP +INTEGER :: JI +! +IMI = GET_CURRENT_MODEL_INDEX() +! +DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST) + IDX = TPOUTPUT%NFIELDLIST(JI) + SELECT CASE (TFIELDLIST(IDX)%NDIMS) + ! + !2D output + ! + CASE (2) + SELECT CASE (TFIELDLIST(IDX)%NTYPE) + ! + !2D real + ! + CASE (TYPEREAL) + IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X2D) ) THEN + PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END IF + IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) ) THEN + PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END IF + CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),HFIPRI,IRESP,TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) + ! + !2D other types + ! + CASE DEFAULT + PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 2D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END SELECT + ! + !3D output + ! + CASE (3) + SELECT CASE (TFIELDLIST(IDX)%NTYPE) + ! + !3D real + ! + CASE (TYPEREAL) + IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X3D) ) THEN + PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X3D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END IF + IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) ) THEN + PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X3D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END IF + CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),HFIPRI,IRESP,TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) + ! + !3D other types + ! + CASE DEFAULT + PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 3D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END SELECT + ! + !Other number of dimensions + ! + CASE DEFAULT + PRINT *,'FATAL: IO_WRITE_FIELDLIST: number of dimensions not yet supported for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) + STOP + END SELECT +END DO +! +END SUBROUTINE IO_WRITE_FIELDLIST +! +! +! +SUBROUTINE IO_WRITE_FIELD_USER(TPOUTPUT,HFIPRI) +! +#if 0 +USE MODD_PARAMETERS, ONLY : JPVEXT +USE MODD_DYN_n, ONLY: XTSTEP +USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT +USE MODD_PRECIP_n, ONLY: XINPRR +#endif +! +IMPLICIT NONE +! +TYPE(TOUTBAK),POINTER,INTENT(IN) :: TPOUTPUT !Output structure +CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM +! +INTEGER :: IRESP +TYPE(TFIELDDATA) :: TZFIELD +! +#if 0 +INTEGER :: IKB +! +IKB=JPVEXT+1 +! +TZFIELD%CMNHNAME = 'UTLOW' +TZFIELD%CSTDNAME = 'x_wind' +TZFIELD%CLONGNAME = '' +TZFIELD%CUNITS = 'm s-1' +TZFIELD%CDIR = 'XY' +TZFIELD%CCOMMENT = 'X_Y_Z_U component of wind (m/s) at lowest physical level' +TZFIELD%NGRID = 2 +TZFIELD%NTYPE = TYPEREAL +TZFIELD%NDIMS = 2 +CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,HFIPRI,IRESP,XUT(:,:,IKB)) +! +TZFIELD%CMNHNAME = 'VTLOW' +TZFIELD%CSTDNAME = 'y_wind' +TZFIELD%CLONGNAME = '' +TZFIELD%CUNITS = 'm s-1' +TZFIELD%CDIR = 'XY' +TZFIELD%CCOMMENT = 'X_Y_Z_V component of wind (m/s) at lowest physical level' +TZFIELD%NGRID = 3 +TZFIELD%NTYPE = TYPEREAL +TZFIELD%NDIMS = 2 +CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,HFIPRI,IRESP,XVT(:,:,IKB)) +! +TZFIELD%CMNHNAME = 'THTLOW' +TZFIELD%CSTDNAME = 'air_potential_temperature' +TZFIELD%CLONGNAME = '' +TZFIELD%CUNITS = 'K' +TZFIELD%CDIR = 'XY' +TZFIELD%CCOMMENT = 'X_Y_Z_potential temperature (K) at lowest physical level' +TZFIELD%NGRID = 1 +TZFIELD%NTYPE = TYPEREAL +TZFIELD%NDIMS = 2 +CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,HFIPRI,IRESP,XTHT(:,:,IKB)) +! +TZFIELD%CMNHNAME = 'RVTLOW' +!TZFIELD%CSTDNAME = 'humidity_mixing_ratio' !ratio of the mass of water vapor to the mass of dry air +TZFIELD%CSTDNAME = 'specific_humidity' !mass fraction of water vapor in (moist) air +TZFIELD%CLONGNAME = '' +TZFIELD%CUNITS = 'kg kg-1' +TZFIELD%CDIR = 'XY' +TZFIELD%CCOMMENT = 'X_Y_Z_Vapor mixing Ratio (KG/KG) at lowest physical level' +TZFIELD%NGRID = 1 +TZFIELD%NTYPE = TYPEREAL +TZFIELD%NDIMS = 2 +CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,HFIPRI,IRESP,XRT(:,:,IKB,1)) +! +TZFIELD%CMNHNAME = 'ACPRRSTEP' +TZFIELD%CSTDNAME = 'rainfall_amount' +TZFIELD%CLONGNAME = '' +TZFIELD%CUNITS = 'kg m-2' +TZFIELD%CDIR = '' +TZFIELD%CCOMMENT = 'X_Y_ACcumulated Precipitation Rain Rate during timestep (kg m-2)' +TZFIELD%NGRID = 1 +TZFIELD%NTYPE = TYPEREAL +TZFIELD%NDIMS = 2 +!XACPRR is multiplied by 1000. to convert from m to kg m-2 (water density is assumed to be 1000 kg m-3) +CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,HFIPRI,IRESP,XINPRR*XTSTEP*1.0E3) +#endif +! +END SUBROUTINE IO_WRITE_FIELD_USER +! +END MODULE MODE_IO_WRITE_FIELD diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90 index 6e5d84c8088283adcc9abc4e266ebd3057e1c7e7..7158dbefd36ab276706857bdbb27c6dac6e8afaa 100644 --- a/src/LIB/SURCOUCHE/src/mode_fm.f90 +++ b/src/LIB/SURCOUCHE/src/mode_fm.f90 @@ -28,7 +28,6 @@ INTEGER, PARAMETER :: JPPIPE = 10 PUBLIC SET_FMPACK_ll,FMATTR_ll,FMLOOK_ll,FMOPEN_ll,FMCLOS_ll PUBLIC IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll -PUBLIC IO_WRITE_FIELDLIST,IO_WRITE_FIELD_USER CONTAINS @@ -574,87 +573,4 @@ WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM END SUBROUTINE FM_ERR -SUBROUTINE IO_WRITE_FIELDLIST(TPOUTPUT,HFIPRI) -! -USE MODD_IO_ll, ONLY: TOUTBAK -USE MODE_FIELD -USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX -USE MODE_FMWRIT -! -IMPLICIT NONE -! -TYPE(TOUTBAK),POINTER,INTENT(IN) :: TPOUTPUT !Output structure -CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM -! -INTEGER :: IDX -INTEGER :: IMI -INTEGER :: IRESP -INTEGER :: JI -! -IMI = GET_CURRENT_MODEL_INDEX() -! -DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST) - IDX = TPOUTPUT%NFIELDLIST(JI) - SELECT CASE (TFIELDLIST(IDX)%NDIMS) - ! - !2D output - ! - CASE (2) - SELECT CASE (TFIELDLIST(IDX)%NTYPE) - ! - !2D real - ! - CASE (TYPEREAL) - IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X2D) ) THEN - PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END IF - IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) ) THEN - PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END IF - CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),HFIPRI,IRESP,TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) - ! - !2D other types - ! - CASE DEFAULT - PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 2D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END SELECT - ! - !3D output - ! - CASE (3) - SELECT CASE (TFIELDLIST(IDX)%NTYPE) - ! - !3D real - ! - CASE (TYPEREAL) - IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X3D) ) THEN - PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X3D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END IF - IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) ) THEN - PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X3D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END IF - CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),HFIPRI,IRESP,TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) - ! - !3D other types - ! - CASE DEFAULT - PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 3D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END SELECT - ! - !Other number of dimensions - ! - CASE DEFAULT - PRINT *,'FATAL: IO_WRITE_FIELDLIST: number of dimensions not yet supported for ',TRIM(TFIELDLIST(IDX)%CMNHNAME) - STOP - END SELECT -END DO -! -END SUBROUTINE IO_WRITE_FIELDLIST - END MODULE MODE_FM diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90 index f3a51a75b23257cdbd41a45477d0fa38147aeb31..c8bca71dfac1ceeb60e396a8fab81d261e08ac9a 100644 --- a/src/MNH/modeln.f90 +++ b/src/MNH/modeln.f90 @@ -257,6 +257,7 @@ USE MODE_ELEC_ll USE MODE_NETCDF ! USE MODE_FM +USE MODE_IO_WRITE_FIELD ! USE MODD_TIME USE MODD_DYN