diff --git a/CaMa/src/ICI/MAIN_cmf_ici.F90 b/CaMa/src/ICI/MAIN_cmf_ici.F90 index 48f0d804..5eea6663 100755 --- a/CaMa/src/ICI/MAIN_cmf_ici.F90 +++ b/CaMa/src/ICI/MAIN_cmf_ici.F90 @@ -5,79 +5,79 @@ PROGRAM MAIN_cmf_ici ! (C) M. Hatono & D.Yamazaki (Tohoku-U / U-Tokyo) Sep 2019 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPRB, JPRM, JPIM -USE YOS_CMF_INPUT, ONLY: NXIN, NYIN, DT, DTIN -USE YOS_CMF_TIME, ONLY: NSTEPS -! -USE CMF_DRV_CONTROL_MOD, ONLY: CMF_DRV_INPUT, CMF_DRV_INIT, CMF_DRV_END -USE CMF_DRV_ADVANCE_MOD, ONLY: CMF_DRV_ADVANCE -!USE CMF_CTRL_FORCING_MOD, ONLY: CMF_FORCING_GET, CMF_FORCING_PUT -! -USE CMF_CTRL_ICI_MOD, ONLY: CMF_ICI_INPUT, CMF_ICI_INIT, CMF_ICI_END -USE CMF_CTRL_ICI_MOD, ONLY: CMF_ICI_FORCING_GET,CMF_ICI_OUTPUT -USE palmtime, ONLY: palm_TimeStart, palm_TimeEnd -!$ USE OMP_LIB -IMPLICIT NONE -! Local variables -INTEGER(KIND=JPIM) :: ISTEP ! total time step -INTEGER(KIND=JPIM) :: ISTEPADV ! time step to be advanced within DRV_ADVANCE -REAL(KIND=JPRB),ALLOCATABLE :: ZBUFF(:,:,:) ! Buffer to store forcing runoff + USE PARKIND1, only: JPRB, JPRM, JPIM + USE YOS_CMF_INPUT, only: NXIN, NYIN, DT, DTIN + USE YOS_CMF_TIME, only: NSTEPS + ! + USE CMF_DRV_CONTROL_MOD, only: CMF_DRV_INPUT, CMF_DRV_INIT, CMF_DRV_END + USE CMF_DRV_ADVANCE_MOD, only: CMF_DRV_ADVANCE + !USE CMF_CTRL_FORCING_MOD, only: CMF_FORCING_GET, CMF_FORCING_PUT + ! + USE CMF_CTRL_ICI_MOD, only: CMF_ICI_INPUT, CMF_ICI_INIT, CMF_ICI_END + USE CMF_CTRL_ICI_MOD, only: CMF_ICI_FORCING_GET,CMF_ICI_OUTPUT + USE palmtime, only: palm_TimeStart, palm_TimeEnd + !$ USE OMP_LIB + IMPLICIT NONE + ! Local variables + integer(KIND=JPIM) :: ISTEP ! total time step + integer(KIND=JPIM) :: ISTEPADV ! time step to be advanced within DRV_ADVANCE + real(KIND=JPRB),ALLOCATABLE :: ZBUFF(:,:,:) ! Buffer to store forcing runoff !================================================ -!*** 1a. Namelist handling -CALL CMF_ICI_INPUT -CALL CMF_DRV_INPUT + !*** 1a. Namelist handling + CALL CMF_ICI_INPUT + CALL CMF_DRV_INPUT -!*** 1b. INITIALIZATION -CALL CMF_DRV_INIT -CALL CMF_ICI_INIT + !*** 1b. INITIALIZATION + CALL CMF_DRV_INIT + CALL CMF_ICI_INIT -!*** 1c. allocate data buffer for input forcing -ALLOCATE(ZBUFF(NXIN,NYIN,2)) + !*** 1c. allocate data buffer for input forcing + allocate(ZBUFF(NXIN,NYIN,2)) -!================================================ -!*** 2. MAIN TEMPORAL LOOP / TIME-STEP (NSTEPS calculated by DRV_INIT) + !================================================ + !*** 2. MAIN TEMPORAL LOOP / TIME-STEP (NSTEPS calculated by DRV_INIT) -!ISTEPADV=INT(DTIN/DT,JPIM) -!DO ISTEP=1,NSTEPS,ISTEPADV + !ISTEPADV=INT(DTIN/DT,JPIM) + !DO ISTEP=1,NSTEPS,ISTEPADV -CALL palm_TimeStart( 'Main' ) + CALL palm_TimeStart( 'Main' ) -ISTEPADV=1 -DO ISTEP=1,NSTEPS,1 + ISTEPADV=1 + DO ISTEP=1,NSTEPS,1 - !* 2a Get forcing from ICI - CALL palm_TimeStart( 'CAMA_forcing' ) - CALL CMF_ICI_FORCING_GET - CALL palm_TimeEnd ( 'CAMA_forcing' ) + !* 2a Get forcing from ICI + CALL palm_TimeStart( 'CAMA_forcing' ) + CALL CMF_ICI_FORCING_GET + CALL palm_TimeEnd ( 'CAMA_forcing' ) - !* 2b Advance CaMa-Flood model for ISTEPADV - CALL palm_TimeStart( 'CAMA_driver' ) - CALL CMF_DRV_ADVANCE(ISTEPADV) - CALL palm_TimeEnd ( 'CAMA_driver' ) - - !* 2c Output data with ICI - CALL palm_TimeStart( 'CAMA_output' ) - CALL CMF_ICI_OUTPUT - CALL palm_TimeEnd ( 'CAMA_output' ) + !* 2b Advance CaMa-Flood model for ISTEPADV + CALL palm_TimeStart( 'CAMA_driver' ) + CALL CMF_DRV_ADVANCE(ISTEPADV) + CALL palm_TimeEnd ( 'CAMA_driver' ) + + !* 2c Output data with ICI + CALL palm_TimeStart( 'CAMA_output' ) + CALL CMF_ICI_OUTPUT + CALL palm_TimeEnd ( 'CAMA_output' ) -ENDDO -CALL palm_TimeEnd ( 'Main' ) -!================================================ + ENDDO + CALL palm_TimeEnd ( 'Main' ) + !================================================ -!*** 3a. Finalize -DEALLOCATE(ZBUFF) -CALL CMF_DRV_END -CALL CMF_ICI_END + !*** 3a. Finalize + deallocate(ZBUFF) + CALL CMF_DRV_END + CALL CMF_ICI_END -!================================================ + !================================================ END PROGRAM MAIN_cmf_ici !#################################################################### diff --git a/CaMa/src/ICI/cmf_calc_lakein_mod.F90 b/CaMa/src/ICI/cmf_calc_lakein_mod.F90 index f8ae488c..a0dfd37c 100755 --- a/CaMa/src/ICI/cmf_calc_lakein_mod.F90 +++ b/CaMa/src/ICI/cmf_calc_lakein_mod.F90 @@ -12,7 +12,7 @@ MODULE CMF_CALC_LAKEIN_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRM, JPRB + USE PARKIND1, only: JPIM, JPRM, JPRB CONTAINS !#################################################################### ! -- CMF_CALC_LAKEIN @@ -20,87 +20,76 @@ MODULE CMF_CALC_LAKEIN_MOD ! -- CMF_LAKEIN_AVERAGE ! -- CMF_RESET_LAKEIN !#################################################################### -SUBROUTINE CMF_CALC_LAKEIN -USE YOS_CMF_INPUT, ONLY: DT -USE YOS_CMF_MAP, ONLY: NSEQALL, D2GRAREA -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO -USE YOS_CMF_DIAG, ONLY: D2STORGE -USE YOS_CMF_ICI, ONLY: D2LAKEFRC, D2RUNIN -IMPLICIT NONE -!*** Local -INTEGER(KIND=JPIM) :: ISEQ -REAL(KIND=JPRB) :: DRIVRIN, DFLDRIN -!*** Lake Parameter -REAL(KIND=JPRB) :: RINDMP -!================================================ -RINDMP = 1.D0 - -DO ISEQ=1, NSEQALL - DRIVRIN = P2RIVSTO(ISEQ,1) * D2LAKEFRC(ISEQ,1) / (RINDMP * 8.64D4) * DT !! m3 - DFLDRIN = P2FLDSTO(ISEQ,1) * D2LAKEFRC(ISEQ,1) / (RINDMP * 8.64D4) * DT !! m3 - P2RIVSTO(ISEQ,1) = P2RIVSTO(ISEQ,1) - DRIVRIN - P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) - DFLDRIN - D2RUNIN(ISEQ,1) = (DRIVRIN + DFLDRIN) / DT / D2GRAREA(ISEQ,1) * 1.D3 !! kg/m2/s - - D2STORGE(ISEQ,1)=P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) -ENDDO - -END SUBROUTINE CMF_CALC_LAKEIN -!#################################################################### - - - - - - -!#################################################################### -SUBROUTINE CMF_LAKEIN_AVE -USE YOS_CMF_INPUT, ONLY: DT -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_ICI, ONLY: D2RUNIN, D2RUNIN_AVG -IMPLICIT NONE -!*** Local -INTEGER(KIND=JPIM) :: ISEQ -!================================================ -DO ISEQ=1, NSEQALL - D2RUNIN_AVG(ISEQ,1)=D2RUNIN_AVG(ISEQ,1)+D2RUNIN(ISEQ,1)*DT -END DO - -END SUBROUTINE CMF_LAKEIN_AVE -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_LAKEIN_AVERAGE -USE YOS_CMF_DIAG, ONLY: NADD -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_ICI, ONLY: D2RUNIN_AVG -IMPLICIT NONE -!*** Local -INTEGER(KIND=JPIM) :: ISEQ -!================================================ -DO ISEQ=1, NSEQALL - D2RUNIN_AVG(ISEQ,1)=D2RUNIN_AVG(ISEQ,1)/DBLE(NADD) -END DO - -END SUBROUTINE CMF_LAKEIN_AVERAGE -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_RESET_LAKEIN -USE YOS_CMF_ICI, ONLY: D2RUNIN_AVG -IMPLICIT NONE -!================================================ -D2RUNIN_AVG(:,:)=0._JPRB - -END SUBROUTINE CMF_RESET_LAKEIN -!#################################################################### + SUBROUTINE CMF_CALC_LAKEIN + USE YOS_CMF_INPUT, only: DT + USE YOS_CMF_MAP, only: NSEQALL, D2GRAREA + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO + USE YOS_CMF_DIAG, only: D2STORGE + USE YOS_CMF_ICI, only: D2LAKEFRC, D2RUNIN + IMPLICIT NONE + !*** Local + integer(KIND=JPIM) :: ISEQ + real(KIND=JPRB) :: DRIVRIN, DFLDRIN + !*** Lake Parameter + real(KIND=JPRB) :: RINDMP + !================================================ + RINDMP = 1.D0 + + DO ISEQ=1, NSEQALL + DRIVRIN = P2RIVSTO(ISEQ,1) * D2LAKEFRC(ISEQ,1) / (RINDMP * 8.64D4) * DT !! m3 + DFLDRIN = P2FLDSTO(ISEQ,1) * D2LAKEFRC(ISEQ,1) / (RINDMP * 8.64D4) * DT !! m3 + P2RIVSTO(ISEQ,1) = P2RIVSTO(ISEQ,1) - DRIVRIN + P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) - DFLDRIN + D2RUNIN(ISEQ,1) = (DRIVRIN + DFLDRIN) / DT / D2GRAREA(ISEQ,1) * 1.D3 !! kg/m2/s + + D2STORGE(ISEQ,1)=P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) + ENDDO + + END SUBROUTINE CMF_CALC_LAKEIN + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_LAKEIN_AVE + USE YOS_CMF_INPUT, only: DT + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_ICI, only: D2RUNIN, D2RUNIN_AVG + IMPLICIT NONE + !*** Local + integer(KIND=JPIM) :: ISEQ + !================================================ + DO ISEQ=1, NSEQALL + D2RUNIN_AVG(ISEQ,1)=D2RUNIN_AVG(ISEQ,1)+D2RUNIN(ISEQ,1)*DT + ENDDO + + END SUBROUTINE CMF_LAKEIN_AVE + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_LAKEIN_AVERAGE + USE YOS_CMF_DIAG, only: NADD + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_ICI, only: D2RUNIN_AVG + IMPLICIT NONE + !*** Local + integer(KIND=JPIM) :: ISEQ + !================================================ + DO ISEQ=1, NSEQALL + D2RUNIN_AVG(ISEQ,1)=D2RUNIN_AVG(ISEQ,1)/DBLE(NADD) + ENDDO + + END SUBROUTINE CMF_LAKEIN_AVERAGE + !#################################################################### + + !#################################################################### + SUBROUTINE CMF_RESET_LAKEIN + USE YOS_CMF_ICI, only: D2RUNIN_AVG + IMPLICIT NONE + !================================================ + D2RUNIN_AVG(:,:)=0._JPRB + + END SUBROUTINE CMF_RESET_LAKEIN + !#################################################################### END MODULE CMF_CALC_LAKEIN_MOD diff --git a/CaMa/src/ICI/cmf_ctrl_ici_mod.F90 b/CaMa/src/ICI/cmf_ctrl_ici_mod.F90 index 1dd2a8a8..6571d01b 100755 --- a/CaMa/src/ICI/cmf_ctrl_ici_mod.F90 +++ b/CaMa/src/ICI/cmf_ctrl_ici_mod.F90 @@ -12,53 +12,53 @@ MODULE CMF_CTRL_ICI_MOD ! (C) M.Hatono and D.Yamazaki (Tohoku-U, U-Tokyo) Sep 2019 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -! shared variables in module -USE mpi -USE PARKIND1, ONLY: JPIM, JPRB -USE YOS_CMF_INPUT, ONLY: LOGNAM -USE YOS_CMF_ICI, ONLY: LLAKEIN -USE palmtime, ONLY: palm_TimeInit, palm_TimeStart, palm_TimeEnd, palm_TimeFinalize -IMPLICIT NONE -SAVE -!*** NAMELIST/cama_ici/ -CHARACTER(LEN=256) :: my_comp -CHARACTER(LEN=256) :: my_grid -CHARACTER(LEN=256) :: namelist_ici_file -INTEGER(KIND=JPIM) :: intpl_num -NAMELIST/cama_ici/ my_comp, my_grid, namelist_ici_file, intpl_num - -!*** NAMELIST/cama_ici_intpl/ -CHARACTER(LEN=256) :: send_comp -CHARACTER(LEN=256) :: send_grid -CHARACTER(LEN=256) :: recv_comp -CHARACTER(LEN=256) :: recv_grid -CHARACTER(LEN=256) :: map_file -CHARACTER(LEN=256) :: intpl_file -INTEGER(KIND=JPIM) :: intpl_map - -NAMELIST/cama_ici_intpl/ send_comp, send_grid, recv_comp, recv_grid, intpl_map, map_file, intpl_file - -!*** NAMELIST/cama_ici_force/ -REAL(KIND=JPRB) :: mrofunit -NAMELIST/cama_ici_force/ mrofunit - -!*** NAMELIST/cama_ici_lake/ -LOGICAL :: nm_llakein = .true. -NAMELIST/cama_ici_lake/ nm_llakein - -! local variables -INTEGER(KIND=JPIM) :: time_array(6) = (/2000,1,1,0,0,0/) ! simulation time step - -REAL(KIND=JPRB) :: ZTT0, ZTT1, ZTT2 ! Time elapsed related -INTEGER(KIND=JPIM) :: ierr, Nproc, Nid, my_comm ! MPI related -!========================================================== +! shared variables in MODULE + USE mpi + USE PARKIND1, only: JPIM, JPRB + USE YOS_CMF_INPUT, only: LOGNAM + USE YOS_CMF_ICI, only: LLAKEIN + USE palmtime, only: palm_TimeInit, palm_TimeStart, palm_TimeEnd, palm_TimeFinalize + IMPLICIT NONE + SAVE + !*** NAMELIST/cama_ici/ + character(LEN=256) :: my_comp + character(LEN=256) :: my_grid + character(LEN=256) :: namelist_ici_file + integer(KIND=JPIM) :: intpl_num + NAMELIST/cama_ici/ my_comp, my_grid, namelist_ici_file, intpl_num + + !*** NAMELIST/cama_ici_intpl/ + character(LEN=256) :: send_comp + character(LEN=256) :: send_grid + character(LEN=256) :: recv_comp + character(LEN=256) :: recv_grid + character(LEN=256) :: map_file + character(LEN=256) :: intpl_file + integer(KIND=JPIM) :: intpl_map + + NAMELIST/cama_ici_intpl/ send_comp, send_grid, recv_comp, recv_grid, intpl_map, map_file, intpl_file + + !*** NAMELIST/cama_ici_force/ + real(KIND=JPRB) :: mrofunit + NAMELIST/cama_ici_force/ mrofunit + + !*** NAMELIST/cama_ici_lake/ + logical :: nm_llakein = .true. + NAMELIST/cama_ici_lake/ nm_llakein + + ! local variables + integer(KIND=JPIM) :: time_array(6) = (/2000,1,1,0,0,0/) ! simulation time step + + real(KIND=JPRB) :: ZTT0, ZTT1, ZTT2 ! Time elapsed related + integer(KIND=JPIM) :: ierr, Nproc, Nid, my_comm ! MPI related + !========================================================== CONTAINS !#################################################################### ! -- CMF_ICI_INPUT : Read setting from Namelist @@ -66,367 +66,351 @@ MODULE CMF_CTRL_ICI_MOD ! -- CMF_ICI_END : Finalize ICI coupler ! !#################################################################### -SUBROUTINE CMF_ICI_INPUT -! Set ici namelist -USE YOS_CMF_INPUT, ONLY: NSETFILE, CLOGOUT -USE YOS_CMF_MAP, ONLY: REGIONALL,REGIONTHIS, MPI_COMM_CAMA -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -USE ici_api, ONLY: ici_init, ici_get_numpe_local, ici_get_irank_local, ici_get_comm_local -IMPLICIT NONE -!* local variables -!================================================ -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE='input_cmf.nam',STATUS="OLD") -REWIND(NSETFILE) -READ(NSETFILE,NML=cama_ici) -REWIND(NSETFILE) -READ(NSETFILE,NML=cama_ici_force) -REWIND(NSETFILE) -READ(NSETFILE,NML=cama_ici_lake) -LLAKEIN = nm_llakein -CLOSE(NSETFILE) - -!*** Initialize MPI -CALL MPI_Init(ierr) -CALL ici_init(my_comp, namelist_ici_file) -CALL palm_TimeInit("CAMA",comm=ici_get_comm_local()) - -Nproc = ici_get_numpe_local() -Nid = ici_get_irank_local() -MPI_COMM_CAMA = ici_get_comm_local() -REGIONALL = Nproc -REGIONTHIS = Nid+1 - -END SUBROUTINE CMF_ICI_INPUT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_ICI_INIT -! Initialize ICI -!$ USE OMP_LIB -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "CMF::ICI_INIT: (1) Set Time & Map" -CALL palm_TimeStart( 'Setup' ) - -!*** 1a. Set mapping table -CALL ICI_MAPTABLE_INIT - -!*** 1b. Set time related -CALL ICI_TIME_INIT - -!*** 1c. Allocate lake variables -IF (LLAKEIN) THEN - CALL ICI_LAKE_INIT -ENDIF - -!================================================ -WRITE(LOGNAM,*) "CMF::ICI_INIT: (2) Set Output, Forcing, Boundary" - -!*** 2. Create first data output -CALL ICI_OUTPUT_INIT - -!=============================================== -CALL palm_TimeEnd ( 'Setup' ) - -CONTAINS -!========================================================== -!+ ICI_MAPTABLE_INIT : Define CaMa grids and set mapping table -!========================================================== -SUBROUTINE ICI_MAPTABLE_INIT -! Define CaMa grids and set mapping table -! -- call from CMF_ICI_INIT -USE YOS_CMF_INPUT, ONLY: NSETFILE,NX -USE YOS_CMF_MAP, ONLY: I1SEQX, I1SEQY, NSEQALL -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -USE ici_api, ONLY: ici_def_grid, ici_end_grid_def -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM) :: ix,iy,iseq,i -INTEGER(KIND=JPIM) :: cama_grid(NSEQALL) -!================================================ -DO iseq=1,NSEQALL - ix=I1SEQX(ISEQ) - iy=I1SEQY(ISEQ) - cama_grid(ISEQ)=ix+(iy-1)*NX -ENDDO - -CALL ici_def_grid(my_grid,NSEQALL,1,1,cama_grid) -CALL ici_end_grid_def() - -END SUBROUTINE ICI_MAPTABLE_INIT -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE ICI_TIME_INIT -! Initialize time for ICI -USE YOS_CMF_TIME, ONLY: ISYYYY,ISMM,ISDD,ISHOUR -USE ici_api, ONLY: ici_init_time -IMPLICIT NONE -!================================================ -time_array(1)=ISYYYY -time_array(2)=ISMM -time_array(3)=ISDD -time_array(4)=ISHOUR -CALL ici_init_time(time_array) - -END SUBROUTINE ICI_TIME_INIT -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE ICI_LAKE_INIT -! Initialize lake variables -USE YOS_CMF_MAP, ONLY: NSEQMAX -USE YOS_CMF_ICI, ONLY: D2LAKEFRC, D2RUNIN, D2RUNIN_AVG -IMPLICIT NONE -!================================================ -ALLOCATE(D2LAKEFRC(NSEQMAX,1)) -ALLOCATE(D2RUNIN(NSEQMAX,1)) -ALLOCATE(D2RUNIN_AVG(NSEQMAX,1)) -D2LAKEFRC(:,:) = 0._JPRB -D2RUNIN(:,:) = 0._JPRB -D2RUNIN_AVG(:,:) = 0._JPRB - -END SUBROUTINE ICI_LAKE_INIT -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE ICI_OUTPUT_INIT -! Create first data output -USE YOS_CMF_INPUT, ONLY: LOUTPUT, IFRQ_OUT, LPTHOUT, LGDWDLY, LROSPLIT -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, P2GDWSTO -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV, D2STORGE, & - & D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & - & D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & - & D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_ICI, ONLY: D2RUNIN_AVG, D2LAKEFRC -USE ici_api, ONLY: ici_put_data -IMPLICIT NONE -!================================================ -call ici_put_data("rivout", D2RIVOUT_AVG(:NSEQALL,1)) -call ici_put_data("rivsto", P2RIVSTO(:NSEQALL,1)) -call ici_put_data("rivdph", D2RIVDPH(:NSEQALL,1)) -call ici_put_data("rivvel", D2RIVVEL_AVG(:NSEQALL,1)) -call ici_put_data("fldout", D2FLDOUT_AVG(:NSEQALL,1)) -call ici_put_data("fldsto", P2FLDSTO(:NSEQALL,1)) -call ici_put_data("flddph", D2FLDDPH(:NSEQALL,1)) -call ici_put_data("fldfrc", D2FLDFRC(:NSEQALL,1)) -call ici_put_data("fldare", D2FLDARE(:NSEQALL,1)) -call ici_put_data("sfcelv", D2SFCELV(:NSEQALL,1)) -call ici_put_data("outflw", D2OUTFLW_AVG(:NSEQALL,1)) -call ici_put_data("storge", D2STORGE(:NSEQALL,1)) -call ici_put_data("runoff_o", D2RUNOFF_AVG(:NSEQALL,1)) -call ici_put_data("maxflw", D2OUTFLW_MAX(:NSEQALL,1)) -call ici_put_data("maxsto", D2STORGE_MAX(:NSEQALL,1)) -call ici_put_data("maxdph", D2RIVDPH_MAX(:NSEQALL,1)) -IF (LPTHOUT) THEN - call ici_put_data("pthout", D2PTHOUT_AVG(:NSEQALL,1)) - !call ici_put_data("pthflw", D1PTHFLW_AVG(:,:)) -ENDIF -IF (LGDWDLY) THEN - call ici_put_data("gdwsto", P2GDWSTO(:NSEQALL,1)) - call ici_put_data("gdwrtn", D2GDWRTN_AVG(:NSEQALL,1)) -ENDIF -IF (LROSPLIT) THEN - call ici_put_data("rofsub", D2ROFSUB_AVG(:NSEQALL,1)) -ENDIF -IF (LLAKEIN) THEN - call ici_put_data("lkfrac" , D2LAKEFRC(:NSEQALL,1)) - call ici_put_data("runin" , D2RUNIN_AVG(:NSEQALL,1)) - call ici_put_data("runin_2m",D2RUNIN_AVG(:NSEQALL,1)) -ENDIF - -IF ( .not. LOUTPUT ) THEN - IFRQ_OUT = -1 -ENDIF - -END SUBROUTINE ICI_OUTPUT_INIT -!========================================================== - - -END SUBROUTINE CMF_ICI_INIT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_ICI_FORCING_GET -! -- CMF_ICI_FORCING_GET : Update time, read forcing data from file and convert unit -! read runoff from file -USE YOS_CMF_INPUT, ONLY: DT, LROSPLIT -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_PROG, ONLY: D2RUNOFF, D2ROFSUB -USE ici_api, ONLY: ici_set_time, ici_get_data -USE YOS_CMF_ICI, ONLY: D2LAKEFRC -IMPLICIT NONE -REAL(KIND=JPRB) :: PBUFF(NSEQALL,1) -LOGICAL :: is_get_ok - - -!================================================ -CALL palm_TimeStart( 'ICI_sync' ) -CALL ici_set_time(time_array, int(DT)) -CALL palm_TimeEnd ( 'ICI_sync' ) - -CALL ici_get_data("runoff",PBUFF(:,1),IS_GET_OK=is_get_ok) -IF (is_get_ok) THEN - CALL roff_convert_ici(PBUFF,D2RUNOFF) -endif -IF (LROSPLIT) THEN - CALL ici_get_data("rofsub",PBUFF(:,1),IS_GET_OK=is_get_ok) - IF (is_get_ok) THEN - CALL roff_convert_ici(PBUFF,D2ROFSUB) - ENDIF -ENDIF - -IF (LLAKEIN) THEN - CALL ici_get_data("lakefrc",PBUFF(:,1),IS_GET_OK=is_get_ok) - if( is_get_ok )then - CALL lake_fraction_ici(PBUFF,D2LAKEFRC) - endif -ENDIF - -CONTAINS -!========================================================== -!+ roff_interp_ici -!========================================================== -SUBROUTINE roff_convert_ici(pbuffin,pbuffout) -! Convert units for runoff -USE YOS_CMF_MAP, ONLY: NSEQALL, D2GRAREA -IMPLICIT NONE -REAL(KIND=JPRB),INTENT(IN) :: PBUFFIN(:,:) !! default [kg/m2/s] -REAL(KIND=JPRB),INTENT(OUT) :: PBUFFOUT(:,:) !! m3/s -!$ SAVE -INTEGER(KIND=JPIM) :: ISEQ -!============================ + SUBROUTINE CMF_ICI_INPUT + ! Set ici namelist + USE YOS_CMF_INPUT, only: NSETFILE, CLOGOUT + USE YOS_CMF_MAP, only: REGIONALL,REGIONTHIS, MPI_COMM_CAMA + USE CMF_UTILS_MOD, only: INQUIRE_FID + USE ici_api, only: ici_init, ici_get_numpe_local, ici_get_irank_local, ici_get_comm_local + IMPLICIT NONE + !* local variables + !================================================ + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE='input_cmf.nam',STATUS="OLD") + rewind(NSETFILE) + read(NSETFILE,NML=cama_ici) + rewind(NSETFILE) + read(NSETFILE,NML=cama_ici_force) + rewind(NSETFILE) + read(NSETFILE,NML=cama_ici_lake) + LLAKEIN = nm_llakein + close(NSETFILE) + + !*** Initialize MPI + CALL MPI_Init(ierr) + CALL ici_init(my_comp, namelist_ici_file) + CALL palm_TimeInit("CAMA",comm=ici_get_comm_local()) + + Nproc = ici_get_numpe_local() + Nid = ici_get_irank_local() + MPI_COMM_CAMA = ici_get_comm_local() + REGIONALL = Nproc + REGIONTHIS = Nid+1 + + END SUBROUTINE CMF_ICI_INPUT + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_ICI_INIT + ! Initialize ICI + !$ USE OMP_LIB + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "CMF::ICI_INIT: (1) Set Time & Map" + CALL palm_TimeStart( 'Setup' ) + + !*** 1a. Set mapping table + CALL ICI_MAPTABLE_INIT + + !*** 1b. Set time related + CALL ICI_TIME_INIT + + !*** 1c. Allocate lake variables + IF (LLAKEIN) THEN + CALL ICI_LAKE_INIT + ENDIF + + !================================================ + write(LOGNAM,*) "CMF::ICI_INIT: (2) Set Output, Forcing, Boundary" + + !*** 2. Create first data output + CALL ICI_OUTPUT_INIT + + !=============================================== + CALL palm_TimeEnd ( 'Setup' ) + + CONTAINS + !========================================================== + !+ ICI_MAPTABLE_INIT : Define CaMa grids and set mapping table + !========================================================== + SUBROUTINE ICI_MAPTABLE_INIT + ! Define CaMa grids and set mapping table + ! -- CALL from CMF_ICI_INIT + USE YOS_CMF_INPUT, only: NSETFILE,NX + USE YOS_CMF_MAP, only: I1SEQX, I1SEQY, NSEQALL + USE CMF_UTILS_MOD, only: INQUIRE_FID + USE ici_api, only: ici_def_grid, ici_end_grid_def + IMPLICIT NONE + !* local variables + integer(KIND=JPIM) :: ix,iy,iseq,i + integer(KIND=JPIM) :: cama_grid(NSEQALL) + !================================================ + DO iseq=1,NSEQALL + ix=I1SEQX(ISEQ) + iy=I1SEQY(ISEQ) + cama_grid(ISEQ)=ix+(iy-1)*NX + ENDDO + + CALL ici_def_grid(my_grid,NSEQALL,1,1,cama_grid) + CALL ici_end_grid_def() + + END SUBROUTINE ICI_MAPTABLE_INIT + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE ICI_TIME_INIT + ! Initialize time for ICI + USE YOS_CMF_TIME, only: ISYYYY,ISMM,ISDD,ISHOUR + USE ici_api, only: ici_init_time + IMPLICIT NONE + !================================================ + time_array(1)=ISYYYY + time_array(2)=ISMM + time_array(3)=ISDD + time_array(4)=ISHOUR + CALL ici_init_time(time_array) + + END SUBROUTINE ICI_TIME_INIT + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE ICI_LAKE_INIT + ! Initialize lake variables + USE YOS_CMF_MAP, only: NSEQMAX + USE YOS_CMF_ICI, only: D2LAKEFRC, D2RUNIN, D2RUNIN_AVG + IMPLICIT NONE + !================================================ + ALLOCATE(D2LAKEFRC(NSEQMAX,1)) + ALLOCATE(D2RUNIN(NSEQMAX,1)) + ALLOCATE(D2RUNIN_AVG(NSEQMAX,1)) + D2LAKEFRC(:,:) = 0._JPRB + D2RUNIN(:,:) = 0._JPRB + D2RUNIN_AVG(:,:) = 0._JPRB + + END SUBROUTINE ICI_LAKE_INIT + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE ICI_OUTPUT_INIT + ! Create first data output + USE YOS_CMF_INPUT, only: LOUTPUT, IFRQ_OUT, LPTHOUT, LGDWDLY, LROSPLIT + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, P2GDWSTO + USE YOS_CMF_DIAG, only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV, D2STORGE, & + & D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & + & D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & + & D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_ICI, only: D2RUNIN_AVG, D2LAKEFRC + USE ici_api, only: ici_put_data + IMPLICIT NONE + !================================================ + CALL ici_put_data("rivout", D2RIVOUT_AVG(:NSEQALL,1)) + CALL ici_put_data("rivsto", P2RIVSTO(:NSEQALL,1)) + CALL ici_put_data("rivdph", D2RIVDPH(:NSEQALL,1)) + CALL ici_put_data("rivvel", D2RIVVEL_AVG(:NSEQALL,1)) + CALL ici_put_data("fldout", D2FLDOUT_AVG(:NSEQALL,1)) + CALL ici_put_data("fldsto", P2FLDSTO(:NSEQALL,1)) + CALL ici_put_data("flddph", D2FLDDPH(:NSEQALL,1)) + CALL ici_put_data("fldfrc", D2FLDFRC(:NSEQALL,1)) + CALL ici_put_data("fldare", D2FLDARE(:NSEQALL,1)) + CALL ici_put_data("sfcelv", D2SFCELV(:NSEQALL,1)) + CALL ici_put_data("outflw", D2OUTFLW_AVG(:NSEQALL,1)) + CALL ici_put_data("storge", D2STORGE(:NSEQALL,1)) + CALL ici_put_data("runoff_o", D2RUNOFF_AVG(:NSEQALL,1)) + CALL ici_put_data("maxflw", D2OUTFLW_MAX(:NSEQALL,1)) + CALL ici_put_data("maxsto", D2STORGE_MAX(:NSEQALL,1)) + CALL ici_put_data("maxdph", D2RIVDPH_MAX(:NSEQALL,1)) + IF (LPTHOUT) THEN + CALL ici_put_data("pthout", D2PTHOUT_AVG(:NSEQALL,1)) + !CALL ici_put_data("pthflw", D1PTHFLW_AVG(:,:)) + ENDIF + IF (LGDWDLY) THEN + CALL ici_put_data("gdwsto", P2GDWSTO(:NSEQALL,1)) + CALL ici_put_data("gdwrtn", D2GDWRTN_AVG(:NSEQALL,1)) + ENDIF + IF (LROSPLIT) THEN + CALL ici_put_data("rofsub", D2ROFSUB_AVG(:NSEQALL,1)) + ENDIF + IF (LLAKEIN) THEN + CALL ici_put_data("lkfrac" , D2LAKEFRC(:NSEQALL,1)) + CALL ici_put_data("runin" , D2RUNIN_AVG(:NSEQALL,1)) + CALL ici_put_data("runin_2m",D2RUNIN_AVG(:NSEQALL,1)) + ENDIF + IF ( .not. LOUTPUT ) THEN + IFRQ_OUT = -1 + ENDIF + END SUBROUTINE ICI_OUTPUT_INIT + !========================================================== + END SUBROUTINE CMF_ICI_INIT + !#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_ICI_FORCING_GET + ! -- CMF_ICI_FORCING_GET : Update time, read forcing data from file and convert unit + ! read runoff from file + USE YOS_CMF_INPUT, only: DT, LROSPLIT + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_PROG, only: D2RUNOFF, D2ROFSUB + USE ici_api, only: ici_set_time, ici_get_data + USE YOS_CMF_ICI, only: D2LAKEFRC + IMPLICIT NONE + real(KIND=JPRB) :: PBUFF(NSEQALL,1) + logical :: is_get_ok + + !================================================ + CALL palm_TimeStart( 'ICI_sync' ) + CALL ici_set_time(time_array, int(DT)) + CALL palm_TimeEnd ( 'ICI_sync' ) + + CALL ici_get_data("runoff",PBUFF(:,1),IS_GET_OK=is_get_ok) + IF (is_get_ok) THEN + CALL roff_convert_ici(PBUFF,D2RUNOFF) + ENDIF + IF (LROSPLIT) THEN + CALL ici_get_data("rofsub",PBUFF(:,1),IS_GET_OK=is_get_ok) + IF (is_get_ok) THEN + CALL roff_convert_ici(PBUFF,D2ROFSUB) + ENDIF + ENDIF + + IF (LLAKEIN) THEN + CALL ici_get_data("lakefrc",PBUFF(:,1),IS_GET_OK=is_get_ok) + IF( is_get_ok )THEN + CALL lake_fraction_ici(PBUFF,D2LAKEFRC) + ENDIF + ENDIF + + CONTAINS + !========================================================== + !+ roff_interp_ici + !========================================================== + SUBROUTINE roff_convert_ici(pbuffin,pbuffout) + ! Convert units for runoff + USE YOS_CMF_MAP, only: NSEQALL, D2GRAREA + IMPLICIT NONE + real(KIND=JPRB),intent(in) :: PBUFFIN(:,:) !! default [kg/m2/s] + real(KIND=JPRB),intent(out) :: PBUFFOUT(:,:) !! m3/s + !$ SAVE + integer(KIND=JPIM) :: ISEQ + !============================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - PBUFFOUT(ISEQ,1) = 0.D0 - PBUFFOUT(ISEQ,1) = MAX(PBUFFIN(ISEQ,1),0.D0) * D2GRAREA(ISEQ,1) / mrofunit !! DTIN removed in v395 - PBUFFOUT(ISEQ,1) = MAX(PBUFFOUT(ISEQ,1), 0.D0) -END DO + DO ISEQ=1, NSEQALL + PBUFFOUT(ISEQ,1) = 0.D0 + PBUFFOUT(ISEQ,1) = MAX(PBUFFIN(ISEQ,1),0.D0) * D2GRAREA(ISEQ,1) / mrofunit !! DTIN removed in v395 + PBUFFOUT(ISEQ,1) = MAX(PBUFFOUT(ISEQ,1), 0.D0) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE roff_convert_ici -!========================================================== - -!========================================================== -!+ lake fraction -!========================================================== -SUBROUTINE lake_fraction_ici(pbuffin,pbuffout) -! Read lake fraction -USE YOS_CMF_MAP, ONLY: NSEQALL -IMPLICIT NONE -REAL(KIND=JPRB),INTENT(IN) :: PBUFFIN(:,:) -REAL(KIND=JPRB),INTENT(OUT) :: PBUFFOUT(:,:) -!$ SAVE -INTEGER(KIND=JPIM) :: ISEQ -!============================ + END SUBROUTINE roff_convert_ici + !========================================================== + + !========================================================== + !+ lake fraction + !========================================================== + SUBROUTINE lake_fraction_ici(pbuffin,pbuffout) + ! Read lake fraction + USE YOS_CMF_MAP, only: NSEQALL + IMPLICIT NONE + real(KIND=JPRB),intent(in) :: PBUFFIN(:,:) + real(KIND=JPRB),intent(out) :: PBUFFOUT(:,:) + !$ SAVE + integer(KIND=JPIM) :: ISEQ + !============================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - PBUFFOUT(ISEQ,1) = PBUFFIN(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL + PBUFFOUT(ISEQ,1) = PBUFFIN(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE lake_fraction_ici -!========================================================== - -END SUBROUTINE CMF_ICI_FORCING_GET + END SUBROUTINE lake_fraction_ici + !========================================================== + + END SUBROUTINE CMF_ICI_FORCING_GET + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_ICI_OUTPUT + ! Send output to ICI + USE YOS_CMF_INPUT, only: LPTHOUT, LGDWDLY, LROSPLIT + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, P2GDWSTO + USE YOS_CMF_DIAG, only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV, D2STORGE, & + & D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & + & D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & + & D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_ICI, only: D2RUNIN_AVG, D2LAKEFRC + USE YOS_CMF_TIME, only: JYYYY, JMM, JDD, JHOUR, JMIN + USE CMF_CALC_LAKEIN_MOD,only: CMF_LAKEIN_AVERAGE, CMF_RESET_LAKEIN + USE CMF_CALC_DIAG_MOD, only: CMF_DIAG_AVERAGE, CMF_DIAG_RESET + USE ici_api, only: ici_put_data + IMPLICIT NONE + + CALL CMF_DIAG_AVERAGE + CALL ici_put_data("rivout", D2RIVOUT_AVG(:NSEQALL,1)) + CALL ici_put_data("rivsto", P2RIVSTO(:NSEQALL,1)) + CALL ici_put_data("rivdph", D2RIVDPH(:NSEQALL,1)) + CALL ici_put_data("rivvel", D2RIVVEL_AVG(:NSEQALL,1)) + CALL ici_put_data("fldout", D2FLDOUT_AVG(:NSEQALL,1)) + CALL ici_put_data("fldsto", P2FLDSTO(:NSEQALL,1)) + CALL ici_put_data("flddph", D2FLDDPH(:NSEQALL,1)) + CALL ici_put_data("fldfrc", D2FLDFRC(:NSEQALL,1)) + CALL ici_put_data("fldare", D2FLDARE(:NSEQALL,1)) + CALL ici_put_data("sfcelv", D2SFCELV(:NSEQALL,1)) + CALL ici_put_data("outflw", D2OUTFLW_AVG(:NSEQALL,1)) + CALL ici_put_data("storge", D2STORGE(:NSEQALL,1)) + CALL ici_put_data("runoff_o", D2RUNOFF_AVG(:NSEQALL,1)) + CALL ici_put_data("maxflw", D2OUTFLW_MAX(:NSEQALL,1)) + CALL ici_put_data("maxsto", D2STORGE_MAX(:NSEQALL,1)) + CALL ici_put_data("maxdph", D2RIVDPH_MAX(:NSEQALL,1)) + IF (LPTHOUT) THEN + CALL ici_put_data("pthout", D2PTHOUT_AVG(:NSEQALL,1)) + !CALL ici_put_data("pthflw", D1PTHFLW_AVG(:,:)) + ENDIF + IF (LGDWDLY) THEN + CALL ici_put_data("gdwsto", P2GDWSTO(:NSEQALL,1)) + CALL ici_put_data("gdwrtn", D2GDWRTN_AVG(:NSEQALL,1)) + ENDIF + IF (LROSPLIT) THEN + CALL ici_put_data("rofsub", D2ROFSUB_AVG(:NSEQALL,1)) + ENDIF + IF (LLAKEIN) THEN + CALL CMF_LAKEIN_AVERAGE + CALL ici_put_data("lkfrac" , D2LAKEFRC(:NSEQALL,1)) + CALL ici_put_data("runin" , D2RUNIN_AVG(:NSEQALL,1)) + CALL ici_put_data("runin_2m",D2RUNIN_AVG(:NSEQALL,1)) + CALL CMF_RESET_LAKEIN + ENDIF + CALL CMF_DIAG_RESET + + time_array(1) = JYYYY + time_array(2) = JMM + time_array(3) = JDD + time_array(4) = JHOUR + time_array(5) = JMIN + + END SUBROUTINE CMF_ICI_OUTPUT + !#################################################################### + + !#################################################################### + SUBROUTINE CMF_ICI_END + ! Finalize ICI and MPI + USE ici_api, only: ici_finalize + !$ USE OMP_LIB + IMPLICIT NONE + !========================================================== + CALL palm_TimeFinalize() + CALL ici_finalize(.true., .true.) + + END SUBROUTINE CMF_ICI_END !#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_ICI_OUTPUT -! Send output to ICI -USE YOS_CMF_INPUT, ONLY: LPTHOUT, LGDWDLY, LROSPLIT -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, P2GDWSTO -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV, D2STORGE, & - & D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & - & D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & - & D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_ICI, ONLY: D2RUNIN_AVG, D2LAKEFRC -USE YOS_CMF_TIME, ONLY: JYYYY, JMM, JDD, JHOUR, JMIN -USE CMF_CALC_LAKEIN_MOD,ONLY: CMF_LAKEIN_AVERAGE, CMF_RESET_LAKEIN -USE CMF_CALC_DIAG_MOD, ONLY: CMF_DIAG_AVERAGE, CMF_DIAG_RESET -USE ici_api, ONLY: ici_put_data -IMPLICIT NONE - -call CMF_DIAG_AVERAGE -call ici_put_data("rivout", D2RIVOUT_AVG(:NSEQALL,1)) -call ici_put_data("rivsto", P2RIVSTO(:NSEQALL,1)) -call ici_put_data("rivdph", D2RIVDPH(:NSEQALL,1)) -call ici_put_data("rivvel", D2RIVVEL_AVG(:NSEQALL,1)) -call ici_put_data("fldout", D2FLDOUT_AVG(:NSEQALL,1)) -call ici_put_data("fldsto", P2FLDSTO(:NSEQALL,1)) -call ici_put_data("flddph", D2FLDDPH(:NSEQALL,1)) -call ici_put_data("fldfrc", D2FLDFRC(:NSEQALL,1)) -call ici_put_data("fldare", D2FLDARE(:NSEQALL,1)) -call ici_put_data("sfcelv", D2SFCELV(:NSEQALL,1)) -call ici_put_data("outflw", D2OUTFLW_AVG(:NSEQALL,1)) -call ici_put_data("storge", D2STORGE(:NSEQALL,1)) -call ici_put_data("runoff_o", D2RUNOFF_AVG(:NSEQALL,1)) -call ici_put_data("maxflw", D2OUTFLW_MAX(:NSEQALL,1)) -call ici_put_data("maxsto", D2STORGE_MAX(:NSEQALL,1)) -call ici_put_data("maxdph", D2RIVDPH_MAX(:NSEQALL,1)) -IF (LPTHOUT) THEN - call ici_put_data("pthout", D2PTHOUT_AVG(:NSEQALL,1)) - !call ici_put_data("pthflw", D1PTHFLW_AVG(:,:)) -ENDIF -IF (LGDWDLY) THEN - call ici_put_data("gdwsto", P2GDWSTO(:NSEQALL,1)) - call ici_put_data("gdwrtn", D2GDWRTN_AVG(:NSEQALL,1)) -ENDIF -IF (LROSPLIT) THEN - call ici_put_data("rofsub", D2ROFSUB_AVG(:NSEQALL,1)) -ENDIF -IF (LLAKEIN) THEN - call CMF_LAKEIN_AVERAGE - call ici_put_data("lkfrac" , D2LAKEFRC(:NSEQALL,1)) - call ici_put_data("runin" , D2RUNIN_AVG(:NSEQALL,1)) - call ici_put_data("runin_2m",D2RUNIN_AVG(:NSEQALL,1)) - call CMF_RESET_LAKEIN -ENDIF -call CMF_DIAG_RESET - -time_array(1) = JYYYY -time_array(2) = JMM -time_array(3) = JDD -time_array(4) = JHOUR -time_array(5) = JMIN - -END SUBROUTINE CMF_ICI_OUTPUT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_ICI_END -! Finalize ICI and MPI -USE ici_api, ONLY: ici_finalize -!$ USE OMP_LIB -IMPLICIT NONE -!========================================================== -CALL palm_TimeFinalize() -CALL ici_finalize(.true., .true.) - -END SUBROUTINE CMF_ICI_END -!#################################################################### - END MODULE CMF_CTRL_ICI_MOD diff --git a/CaMa/src/ICI/yos_cmf_ici.F90 b/CaMa/src/ICI/yos_cmf_ici.F90 index ecaa4907..c04b6ad8 100755 --- a/CaMa/src/ICI/yos_cmf_ici.F90 +++ b/CaMa/src/ICI/yos_cmf_ici.F90 @@ -11,14 +11,14 @@ MODULE YOS_CMF_ICI ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPRB -IMPLICIT NONE -SAVE -!================================================ -LOGICAL :: LLAKEIN -REAL(KIND=JPRB),ALLOCATABLE :: D2LAKEFRC(:,:) -REAL(KIND=JPRB),ALLOCATABLE :: D2RUNIN(:,:) -REAL(KIND=JPRB),ALLOCATABLE :: D2RUNIN_AVG(:,:) + USE PARKIND1, only: JPRB + IMPLICIT NONE + SAVE + !================================================ + logical :: LLAKEIN + real(KIND=JPRB),ALLOCATABLE :: D2LAKEFRC(:,:) + real(KIND=JPRB),ALLOCATABLE :: D2RUNIN(:,:) + real(KIND=JPRB),ALLOCATABLE :: D2RUNIN_AVG(:,:) !================================================ END MODULE YOS_CMF_ICI diff --git a/CaMa/src/MAIN_cmf.F90 b/CaMa/src/MAIN_cmf.F90 index 399ac765..87263ef5 100755 --- a/CaMa/src/MAIN_cmf.F90 +++ b/CaMa/src/MAIN_cmf.F90 @@ -13,80 +13,80 @@ PROGRAM MAIN_cmf ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPRB, JPRM, JPIM -USE YOS_CMF_INPUT, ONLY: NXIN, NYIN, DT,DTIN -USE YOS_CMF_TIME, ONLY: NSTEPS -USE CMF_DRV_CONTROL_MOD, ONLY: CMF_DRV_INPUT, CMF_DRV_INIT, CMF_DRV_END -USE CMF_DRV_ADVANCE_MOD, ONLY: CMF_DRV_ADVANCE -USE CMF_CTRL_FORCING_MOD, ONLY: CMF_FORCING_GET, CMF_FORCING_PUT -!** parallelization options** -!$ USE OMP_LIB + USE PARKIND1, only: JPRB, JPRM, JPIM + USE YOS_CMF_INPUT, only: NXIN, NYIN, DT,DTIN + USE YOS_CMF_TIME, only: NSTEPS + USE CMF_DRV_CONTROL_MOD, only: CMF_DRV_INPUT, CMF_DRV_INIT, CMF_DRV_END + USE CMF_DRV_ADVANCE_MOD, only: CMF_DRV_ADVANCE + USE CMF_CTRL_FORCING_MOD, only: CMF_FORCING_GET, CMF_FORCING_PUT + !** parallelization options** + !$ USE OMP_LIB #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_INIT, CMF_MPI_END + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_INIT, CMF_MPI_END #endif -!** sediment options** + !** sediment options** #ifdef sediment -USE YOS_CMF_INPUT, ONLY: LSEDOUT -USE cmf_ctrl_sedinp_mod, ONLY: cmf_sed_forcing + USE YOS_CMF_INPUT, only: LSEDOUT + USE cmf_ctrl_sedinp_mod, only: cmf_sed_forcing #endif -!**************************** -IMPLICIT NONE + !**************************** + IMPLICIT NONE -!** local variables -INTEGER(KIND=JPIM) :: ISTEP ! total time step -INTEGER(KIND=JPIM) :: ISTEPADV ! time step to be advanced within DRV_ADVANCE -REAL(KIND=JPRB),ALLOCATABLE :: ZBUFF(:,:,:) ! Buffer to store forcing runoff + !** local variables + integer(KIND=JPIM) :: ISTEP ! total time step + integer(KIND=JPIM) :: ISTEPADV ! time step to be advanced within DRV_ADVANCE + real(KIND=JPRB),ALLOCATABLE :: ZBUFF(:,:,:) ! Buffer to store forcing runoff !================================================ !*** 0. MPI Initialization #ifdef UseMPI_CMF -CALL CMF_MPI_INIT + CALL CMF_MPI_INIT #endif !*** 1a. Namelist handling -CALL CMF_DRV_INPUT + CALL CMF_DRV_INPUT !*** 1b. INITIALIZATION -CALL CMF_DRV_INIT + CALL CMF_DRV_INIT !*** 1c. allocate data buffer for input forcing -ALLOCATE(ZBUFF(NXIN,NYIN,2)) + allocate(ZBUFF(NXIN,NYIN,2)) !============================ !*** 2. MAIN TEMPORAL LOOP / TIME-STEP (NSTEPS calculated by DRV_INIT) -ISTEPADV=INT(DTIN/DT,JPIM) -DO ISTEP=1,NSTEPS,ISTEPADV + ISTEPADV=INT(DTIN/DT,JPIM) + DO ISTEP=1,NSTEPS,ISTEPADV - !* 2a Read forcing from file, This is only relevant in Stand-alone mode - CALL CMF_FORCING_GET(ZBUFF(:,:,:)) + !* 2a Read forcing from file, This is only relevant in Stand-alone mode + CALL CMF_FORCING_GET(ZBUFF(:,:,:)) - !* 2b Interporlate runoff & send to CaMa-Flood - CALL CMF_FORCING_PUT(ZBUFF(:,:,:)) - - !* 2c Advance CaMa-Flood model for ISTEPADV - CALL CMF_DRV_ADVANCE(ISTEPADV) + !* 2b Interporlate runoff & send to CaMa-Flood + CALL CMF_FORCING_PUT(ZBUFF(:,:,:)) + + !* 2c Advance CaMa-Flood model for ISTEPADV + CALL CMF_DRV_ADVANCE(ISTEPADV) #ifdef sediment - !* 2c Prepare forcing for optional sediment transport in stand-alone mode - IF ( LSEDOUT ) THEN - CALL cmf_sed_forcing - ENDIF + !* 2c Prepare forcing for optional sediment transport in stand-alone mode + IF ( LSEDOUT ) THEN + CALL cmf_sed_forcing + ENDIF #endif -ENDDO + ENDDO !============================ !*** 3a. finalize CaMa-Flood -DEALLOCATE(ZBUFF) -CALL CMF_DRV_END + deallocate(ZBUFF) + CALL CMF_DRV_END !*** 3b. MPI specific finalization #ifdef UseMPI_CMF -CALL CMF_MPI_END + CALL CMF_MPI_END #endif -!================================================ + !================================================ END PROGRAM MAIN_cmf !#################################################################### diff --git a/CaMa/src/MOD_CaMa_Vars.F90 b/CaMa/src/MOD_CaMa_Vars.F90 index ec47e886..46bf6bbd 100644 --- a/CaMa/src/MOD_CaMa_Vars.F90 +++ b/CaMa/src/MOD_CaMa_Vars.F90 @@ -1,6 +1,6 @@ #include -module MOD_CaMa_Vars +MODULE MOD_CaMa_Vars !DESCRIPTION !=========== !---This MODULE is the coupler for the colm and CaMa-Flood model. @@ -8,7 +8,7 @@ module MOD_CaMa_Vars !ANCILLARY FUNCTIONS AND SUBROUTINES !------------------- !* :SUBROUTINE:"allocate_acc_cama_fluxes" : Initilization Accumulation of cama-flood variables - !* :SUBROUTINE:"deallocate_acc_cama_fluxes" : Deallocate Accumulation of cama-flood variables + !* :SUBROUTINE:"deallocate_acc_cama_fluxes" : deallocate Accumulation of cama-flood variables !* :SUBROUTINE:"FLUSH_acc_cama_fluxes" : Reset Accumulation of cama-flood variables !* :SUBROUTINE:"accumulate_cama_fluxes" : Get accumulated cama-flood variables !* :SUBROUTINE:"allocate_2D_cama_Fluxes" : Get floodplain evaporation @@ -25,13 +25,12 @@ module MOD_CaMa_Vars !---2020.10.21 Zhongwang Wei @ SYSU #if(defined CaMa_Flood) - USE MOD_Precision USE MOD_Grid USE MOD_DataType USE MOD_Mapping_Pset2Grid USE MOD_Mapping_Grid2Pset - USE YOS_CMF_INPUT, ONLY:RMIS,DMIS + USE YOS_CMF_INPUT, only: RMIS, DMIS real(r8) :: nacc ! number of accumulation real(r8), allocatable :: a_rnof_cama (:) ! on worker : total runoff [mm/s] @@ -56,423 +55,425 @@ module MOD_CaMa_Vars real(r8), allocatable :: a_finfg_fld (:) ! on worker : flddepth [m] type(block_data_real8_2d) :: f_finfg_fld ! on IO : total runoff [mm/s] real(r8), allocatable :: finfg_2d (:,:) ! on Master : total runoff [mm/s] - TYPE(grid_type) :: gcama + type(grid_type) :: gcama - TYPE (mapping_pset2grid_type) :: mp2g_cama ! mapping pset to grid - TYPE (mapping_grid2pset_type) :: mg2p_cama ! mapping grid to pset + type (mapping_pset2grid_type) :: mp2g_cama ! mapping pset to grid + type (mapping_grid2pset_type) :: mg2p_cama ! mapping grid to pset - TYPE (grid_concat_type) :: cama_gather ! gather grid + type (grid_concat_type) :: cama_gather ! gather grid type(block_data_real8_2d) :: IO_Effdepth ! inundation to water depth [m] type(block_data_real8_2d) :: IO_Effarea ! inundation to water area [m2] - TYPE history_var_cama_type - LOGICAL :: rivout = .false. - LOGICAL :: rivsto = .false. - LOGICAL :: rivdph = .false. - LOGICAL :: rivvel = .false. - LOGICAL :: fldout = .false. - LOGICAL :: fldsto = .false. - LOGICAL :: flddph = .false. - LOGICAL :: fldfrc = .false. - LOGICAL :: fldare = .false. - LOGICAL :: sfcelv = .false. - LOGICAL :: totout = .false. - LOGICAL :: outflw = .false. - LOGICAL :: totsto = .false. - LOGICAL :: storge = .false. - LOGICAL :: pthflw = .false. - LOGICAL :: pthout = .false. - LOGICAL :: maxflw = .false. - LOGICAL :: maxdph = .false. - LOGICAL :: maxsto = .false. - LOGICAL :: gwsto = .false. - LOGICAL :: gdwsto = .false. - LOGICAL :: gwout = .false. - LOGICAL :: gdwrtn = .false. - LOGICAL :: runoff = .false. - LOGICAL :: runoffsub = .false. - LOGICAL :: rofsfc = .false. - LOGICAL :: rofsub = .false. - LOGICAL :: damsto = .false. - LOGICAL :: daminf = .false. - LOGICAL :: wevap = .false. - LOGICAL :: winfilt = .false. - LOGICAL :: levsto = .false. - LOGICAL :: levdph = .false. - END TYPE history_var_cama_type - - TYPE (history_var_cama_type) :: DEF_hist_cama_vars + type history_var_cama_type + logical :: rivout = .false. + logical :: rivsto = .false. + logical :: rivdph = .false. + logical :: rivvel = .false. + logical :: fldout = .false. + logical :: fldsto = .false. + logical :: flddph = .false. + logical :: fldfrc = .false. + logical :: fldare = .false. + logical :: sfcelv = .false. + logical :: totout = .false. + logical :: outflw = .false. + logical :: totsto = .false. + logical :: storge = .false. + logical :: pthflw = .false. + logical :: pthout = .false. + logical :: maxflw = .false. + logical :: maxdph = .false. + logical :: maxsto = .false. + logical :: gwsto = .false. + logical :: gdwsto = .false. + logical :: gwout = .false. + logical :: gdwrtn = .false. + logical :: runoff = .false. + logical :: runoffsub = .false. + logical :: rofsfc = .false. + logical :: rofsub = .false. + logical :: damsto = .false. + logical :: daminf = .false. + logical :: wevap = .false. + logical :: winfilt = .false. + logical :: levsto = .false. + logical :: levdph = .false. + END type history_var_cama_type + + type (history_var_cama_type) :: DEF_hist_cama_vars ! --- subroutines --- - public :: allocate_acc_cama_fluxes - public :: deallocate_acc_cama_fluxes - public :: flush_acc_cama_fluxes - public :: accumulate_cama_fluxes - public :: allocate_2D_cama_Fluxes + PUBLIC :: allocate_acc_cama_fluxes + PUBLIC :: deallocate_acc_cama_fluxes + PUBLIC :: flush_acc_cama_fluxes + PUBLIC :: accumulate_cama_fluxes + PUBLIC :: allocate_2D_cama_Fluxes PUBLIC :: colm2cama_real8 PUBLIC :: cama2colm_real8 PUBLIC :: hist_out_cama -contains +CONTAINS SUBROUTINE allocate_acc_cama_fluxes - !DESCRIPTION - !=========== - ! This subrountine is used for initilization Accumulation of cama-flood variables +!DESCRIPTION +!=========== + ! This subrountine is used for initilization Accumulation of cama-flood variables - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - ! 2021.12.12 Zhongwang Wei @ SYSU +!REVISION HISTORY +!---------------- + ! 2021.12.12 Zhongwang Wei @ SYSU - USE MOD_SPMD_Task !spmd_task - USE MOD_LandPatch, ONLY : numpatch - USE MOD_Vars_Global - IMPLICIT NONE + USE MOD_SPMD_Task !spmd_task + USE MOD_LandPatch, only : numpatch + USE MOD_Vars_Global + + IMPLICIT NONE !allocate cama-flood variables on worker - if (p_is_worker) then - if (numpatch > 0) then + IF (p_is_worker) THEN + IF (numpatch > 0) THEN allocate (a_rnof_cama(numpatch)) allocate (a_fevpg_fld(numpatch)) allocate (a_finfg_fld(numpatch)) - end if - end if + ENDIF + ENDIF END SUBROUTINE allocate_acc_cama_fluxes SUBROUTINE deallocate_acc_cama_fluxes() - !DESCRIPTION - !=========== - ! This subrountine is used for deallocate Accumulation of cama-flood variables +!DESCRIPTION +!=========== +! This subrountine is used for deallocate Accumulation of cama-flood variables - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES + !------------------- - !REVISION HISTORY - !---------------- - ! 2020.10.21 Zhongwang Wei @ SYSU +!REVISION HISTORY + !---------------- + ! 2020.10.21 Zhongwang Wei @ SYSU - USE MOD_SPMD_Task - USE MOD_LandPatch, ONLY : numpatch + USE MOD_SPMD_Task + USE MOD_LandPatch, only : numpatch - IMPLICIT NONE + IMPLICIT NONE - if (p_is_worker) then - if (numpatch > 0) then + IF (p_is_worker) THEN + IF (numpatch > 0) THEN deallocate (a_rnof_cama) deallocate (a_fevpg_fld) deallocate (a_finfg_fld) - end if - end if + ENDIF + ENDIF END SUBROUTINE deallocate_acc_cama_fluxes SUBROUTINE FLUSH_acc_cama_fluxes () - !DESCRIPTION - !=========== - ! This subrountine is used for reset Accumulation of cama-flood variables +!DESCRIPTION +!=========== +! This subrountine is used for reset Accumulation of cama-flood variables - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES + !------------------- - !REVISION HISTORY - !---------------- - ! 2020.10.21 Zhongwang Wei @ SYSU - USE MOD_SPMD_Task - USE MOD_LandPatch, ONLY : numpatch - USE MOD_Vars_Global, ONLY : spval +!REVISION HISTORY + !---------------- + ! 2020.10.21 Zhongwang Wei @ SYSU + USE MOD_SPMD_Task + USE MOD_LandPatch, only: numpatch + USE MOD_Vars_Global, only: spval - IMPLICIT NONE + IMPLICIT NONE - if (p_is_worker) then + IF (p_is_worker) THEN nacc = 0 - if (numpatch > 0) then + IF (numpatch > 0) THEN ! flush the Fluxes for accumulation a_rnof_cama (:) = spval a_fevpg_fld (:) = spval a_finfg_fld (:) = spval - end if - end if + ENDIF + ENDIF END SUBROUTINE FLUSH_acc_cama_fluxes SUBROUTINE accumulate_cama_fluxes - !DESCRIPTION - !=========== - ! This subrountine is used for accumulating cama-flood variables +!DESCRIPTION +!=========== + ! This subrountine is used for accumulating cama-flood variables - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"acc1d_cama" : accumulating 1D cama-flood variables +!ANCILLARY FUNCTIONS AND SUBROUTINES + !------------------- + !* :SUBROUTINE:"acc1d_cama" : accumulating 1D cama-flood variables - !REVISION HISTORY - !---------------- - ! 2020.10.21 Zhongwang Wei @ SYSU +!REVISION HISTORY + !---------------- + ! 2020.10.21 Zhongwang Wei @ SYSU - USE MOD_Precision - USE MOD_SPMD_Task - USE MOD_Vars_1DFluxes, ONLY : rnof - USE MOD_LandPatch, ONLY : numpatch + USE MOD_Precision + USE MOD_SPMD_Task + USE MOD_Vars_1DFluxes, only : rnof + USE MOD_LandPatch, only : numpatch - IMPLICIT NONE + IMPLICIT NONE - if (p_is_worker) then - if (numpatch > 0) then + IF (p_is_worker) THEN + IF (numpatch > 0) THEN nacc = nacc + 1 - call acc1d_cama (rnof, a_rnof_cama) - call acc1d_cama (fevpg_fld, a_fevpg_fld) - call acc1d_cama (finfg_fld, a_finfg_fld) - end if - end if + CALL acc1d_cama (rnof, a_rnof_cama) + CALL acc1d_cama (fevpg_fld, a_fevpg_fld) + CALL acc1d_cama (finfg_fld, a_finfg_fld) + ENDIF + ENDIF END SUBROUTINE accumulate_cama_fluxes SUBROUTINE acc1d_cama (var, s) - !DESCRIPTION - !=========== - ! This subrountine is used for accumulating 1D cama-flood variables +!DESCRIPTION +!=========== + ! This subrountine is used for accumulating 1D cama-flood variables - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES + !------------------- - !REVISION HISTORY - !---------------- - ! 2020.10.21 Zhongwang Wei @ SYSU +!REVISION HISTORY + !---------------- + ! 2020.10.21 Zhongwang Wei @ SYSU - USE MOD_Precision - USE MOD_Vars_Global, ONLY: spval + USE MOD_Precision + USE MOD_Vars_Global, only: spval - IMPLICIT NONE + IMPLICIT NONE real(r8), intent(in) :: var(:) ! variable to be accumulated real(r8), intent(inout) :: s (:) ! new added value - !----------------------- Dummy argument -------------------------------- +!----------------------- Dummy argument -------------------------------- integer :: i - do i = lbound(var,1), ubound(var,1) - if (var(i) /= spval) then - if (s(i) /= spval) then + DO i = lbound(var,1), ubound(var,1) + IF (var(i) /= spval) THEN + IF (s(i) /= spval) THEN s(i) = s(i) + var(i) - else + ELSE s(i) = var(i) - end if - end if - end do + ENDIF + ENDIF + ENDDO END SUBROUTINE acc1d_cama SUBROUTINE allocate_2D_cama_Fluxes (grid) - !DESCRIPTION - !=========== - ! This subrountine is used for accumulating 2D cama-flood variables +!DESCRIPTION +!=========== + ! This subrountine is used for accumulating 2D cama-flood variables - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"allocate_block_data" : allocate 2D cama-flood variables to colm block +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- + !* :SUBROUTINE:"allocate_block_data" : allocate 2D cama-flood variables to colm block - !REVISION HISTORY - !---------------- - ! 2020.10.21 Zhongwang Wei @ SYSU +!REVISION HISTORY + !---------------- + ! 2020.10.21 Zhongwang Wei @ SYSU - USE MOD_SPMD_Task - USE MOD_Grid - USE MOD_DataType + USE MOD_SPMD_Task + USE MOD_Grid + USE MOD_DataType - IMPLICIT NONE + IMPLICIT NONE type(grid_type), intent(in) :: grid - if (p_is_io) then - call allocate_block_data (grid, f_rnof_cama) ! total runoff [m/s] - call allocate_block_data (grid, f_flddepth_cama) ! inundation depth [m/s] - call allocate_block_data (grid, f_fldfrc_cama) ! inundation fraction [m/s] + IF (p_is_io) THEN + CALL allocate_block_data (grid, f_rnof_cama) ! total runoff [m/s] + CALL allocate_block_data (grid, f_flddepth_cama) ! inundation depth [m/s] + CALL allocate_block_data (grid, f_fldfrc_cama) ! inundation fraction [m/s] !TODO: check the following variables - call allocate_block_data (grid, f_fevpg_fld) ! inundation evaporation [m/s] - call allocate_block_data (grid, f_finfg_fld) ! inundation re-infiltration [m/s] - end if + CALL allocate_block_data (grid, f_fevpg_fld) ! inundation evaporation [m/s] + CALL allocate_block_data (grid, f_finfg_fld) ! inundation re-infiltration [m/s] + ENDIF END SUBROUTINE allocate_2D_cama_Fluxes SUBROUTINE hist_out_cama (file_hist, itime_in_file) - !DESCRIPTION - !=========== - ! This subrountine is used for averaging and writing 2D cama-flood variables out - - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"CMF_DIAG_AVERAGE" : averaging the diagnostic variables of cama-flood - !* :SUBROUTINE:"flux_map_and_write_2d_cama" : map camaflood variables to colm block and write out - !* :SUBROUTINE:"CMF_DIAG_RESET" : reset diagnostic variables of cama-flood - !REVISION HISTORY - !---------------- - ! 2020.10.21 Zhongwang Wei @ SYSU - - USE MOD_SPMD_Task - USE CMF_CALC_DIAG_MOD, ONLY: CMF_DIAG_AVERAGE, CMF_DIAG_RESET - USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, P2GDWSTO, & +!DESCRIPTION +!=========== + ! This subrountine is used for averaging and writing 2D cama-flood variables out + +!ANCILLARY FUNCTIONS AND SUBROUTINES + !------------------- + !* :SUBROUTINE:"CMF_DIAG_AVERAGE" : averaging the diagnostic variables of cama-flood + !* :SUBROUTINE:"flux_map_and_write_2d_cama" : map camaflood variables to colm block and write out + !* :SUBROUTINE:"CMF_DIAG_RESET" : reset diagnostic variables of cama-flood +!REVISION HISTORY + !---------------- + ! 2020.10.21 Zhongwang Wei @ SYSU + + USE MOD_SPMD_Task + USE CMF_CALC_DIAG_MOD, only: CMF_DIAG_AVERAGE, CMF_DIAG_RESET + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, P2GDWSTO, & P2damsto,P2LEVSTO !!! added - USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, & - D2SFCELV, D2STORGE, & - D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & - D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & - D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX, & - d2daminf_avg,D2WEVAPEX_AVG,D2WINFILTEX_AVG,D2LEVDPH !!! added + USE YOS_CMF_DIAG, only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, & + D2SFCELV, D2STORGE, & + D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & + D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & + D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX, & + d2daminf_avg, D2WEVAPEX_AVG,D2WINFILTEX_AVG, D2LEVDPH !!! added ! USE MOD_Vars_2DFluxes - IMPLICIT NONE + IMPLICIT NONE - character(LEN=*), intent(in) :: file_hist - integer, intent(in) :: itime_in_file + character(LEN=*), intent(in) :: file_hist + integer, intent(in) :: itime_in_file - !*** average variable - CALL CMF_DIAG_AVERAGE + !*** average variable + CALL CMF_DIAG_AVERAGE - !*** write output data - call flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivout, & - real(D2RIVOUT_AVG), file_hist, 'rivout', itime_in_file,'river discharge','m3/s') + !*** write output data + CALL flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivout, & + real(D2RIVOUT_AVG), file_hist, 'rivout', itime_in_file,'river discharge','m3/s') - call flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivsto, & - real(P2RIVSTO), file_hist, 'rivsto', itime_in_file,'river storage','m3') + CALL flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivsto, & + real(P2RIVSTO), file_hist, 'rivsto', itime_in_file,'river storage','m3') - call flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivdph, & - real(D2RIVDPH), file_hist, 'rivdph', itime_in_file,'river depth','m') + CALL flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivdph, & + real(D2RIVDPH), file_hist, 'rivdph', itime_in_file,'river depth','m') - call flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivvel, & - real(D2RIVVEL_AVG), file_hist, 'rivvel', itime_in_file,'river velocity','m/s') + CALL flux_map_and_write_2d_cama (DEF_hist_cama_vars%rivvel, & + real(D2RIVVEL_AVG), file_hist, 'rivvel', itime_in_file,'river velocity','m/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldout, & - real(D2FLDOUT_AVG), file_hist, 'fldout', itime_in_file,'floodplain discharge','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldout, & + real(D2FLDOUT_AVG), file_hist, 'fldout', itime_in_file,'floodplain discharge','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldsto, & - real(P2FLDSTO), file_hist, 'fldsto', itime_in_file,'floodplain storage','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldsto, & + real(P2FLDSTO), file_hist, 'fldsto', itime_in_file,'floodplain storage','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%flddph, & - real(D2FLDDPH), file_hist, 'flddph', itime_in_file,'floodplain depth','m') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%flddph, & + real(D2FLDDPH), file_hist, 'flddph', itime_in_file,'floodplain depth','m') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldfrc, & - real(D2FLDFRC), file_hist, 'fldfrc', itime_in_file,'flooded fraction','0-1') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldfrc, & + real(D2FLDFRC), file_hist, 'fldfrc', itime_in_file,'flooded fraction','0-1') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldare, & - real(D2FLDARE), file_hist, 'fldare', itime_in_file,'flooded area','m2') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%fldare, & + real(D2FLDARE), file_hist, 'fldare', itime_in_file,'flooded area','m2') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%sfcelv, & - real(D2SFCELV), file_hist, 'sfcelv', itime_in_file,'water surface elevation','m') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%sfcelv, & + real(D2SFCELV), file_hist, 'sfcelv', itime_in_file,'water surface elevation','m') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%totout, & - real(D2OUTFLW_AVG), file_hist, 'totout', itime_in_file,'discharge (river+floodplain)','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%totout, & + real(D2OUTFLW_AVG), file_hist, 'totout', itime_in_file,'discharge (river+floodplain)','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%outflw, & - real(D2OUTFLW_AVG), file_hist, 'outflw', itime_in_file,'discharge (river+floodplain)','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%outflw, & + real(D2OUTFLW_AVG), file_hist, 'outflw', itime_in_file,'discharge (river+floodplain)','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%totsto, & - real(D2STORGE), file_hist, 'totsto', itime_in_file,'total storage (river+floodplain)','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%totsto, & + real(D2STORGE), file_hist, 'totsto', itime_in_file,'total storage (river+floodplain)','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%storge, & - real(D2STORGE), file_hist, 'storge', itime_in_file,'total storage (river+floodplain)','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%storge, & + real(D2STORGE), file_hist, 'storge', itime_in_file,'total storage (river+floodplain)','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%pthflw, & - real(D1PTHFLW_AVG), file_hist, 'pthflw', itime_in_file,'bifurcation channel discharge ','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%pthflw, & + real(D1PTHFLW_AVG), file_hist, 'pthflw', itime_in_file,'bifurcation channel discharge ','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%pthout, & - real(D2PTHOUT_AVG), file_hist, 'pthout', itime_in_file,'net bifurcation discharge','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%pthout, & + real(D2PTHOUT_AVG), file_hist, 'pthout', itime_in_file,'net bifurcation discharge','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%gdwsto, & - real(P2GDWSTO), file_hist, 'gdwsto', itime_in_file,'ground water storage','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%gdwsto, & + real(P2GDWSTO), file_hist, 'gdwsto', itime_in_file,'ground water storage','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%gwsto, & - real(P2GDWSTO), file_hist, 'gwsto', itime_in_file,'ground water storage','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%gwsto, & + real(P2GDWSTO), file_hist, 'gwsto', itime_in_file,'ground water storage','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%gwout, & - real(D2GDWRTN_AVG), file_hist, 'gwout', itime_in_file,'ground water discharge','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%gwout, & + real(D2GDWRTN_AVG), file_hist, 'gwout', itime_in_file,'ground water discharge','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%runoff, & - real(D2RUNOFF_AVG), file_hist, 'runoff', itime_in_file,'Surface runoff','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%runoff, & + real(D2RUNOFF_AVG), file_hist, 'runoff', itime_in_file,'Surface runoff','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%runoffsub, & - real(D2ROFSUB_AVG) , file_hist, 'runoffsub', itime_in_file,'sub-surface runoff','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%runoffsub, & + real(D2ROFSUB_AVG) , file_hist, 'runoffsub', itime_in_file,'sub-surface runoff','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%maxsto, & - real(D2STORGE_MAX), file_hist, 'maxsto', itime_in_file,'daily maximum storage','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%maxsto, & + real(D2STORGE_MAX), file_hist, 'maxsto', itime_in_file,'daily maximum storage','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%maxflw, & - real(D2OUTFLW_MAX), file_hist, 'maxflw', itime_in_file,'daily maximum discharge','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%maxflw, & + real(D2OUTFLW_MAX), file_hist, 'maxflw', itime_in_file,'daily maximum discharge','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%maxdph, & - real(D2RIVDPH_MAX), file_hist, 'maxdph', itime_in_file,'daily maximum river depth','m') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%maxdph, & + real(D2RIVDPH_MAX), file_hist, 'maxdph', itime_in_file,'daily maximum river depth','m') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%damsto, & - real(p2damsto), file_hist, 'damsto', itime_in_file,'reservoir storage','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%damsto, & + real(p2damsto), file_hist, 'damsto', itime_in_file,'reservoir storage','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%daminf, & - real(d2daminf_avg), file_hist, 'daminf', itime_in_file,'reservoir inflow','m3/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%daminf, & + real(d2daminf_avg), file_hist, 'daminf', itime_in_file,'reservoir inflow','m3/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%wevap, & - real(D2WEVAPEX_AVG), file_hist, 'wevap', itime_in_file,'inundation water evaporation','m/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%wevap, & + real(D2WEVAPEX_AVG), file_hist, 'wevap', itime_in_file,'inundation water evaporation','m/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%winfilt, & - real(D2WINFILTEX_AVG), file_hist, 'winfilt', itime_in_file,'inundation water infiltration','m/s') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%winfilt, & + real(D2WINFILTEX_AVG), file_hist, 'winfilt', itime_in_file,'inundation water infiltration','m/s') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%levsto, & - real(P2LEVSTO), file_hist, 'levsto', itime_in_file,'protected area storage','m3') + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%levsto, & + real(P2LEVSTO), file_hist, 'levsto', itime_in_file,'protected area storage','m3') - call flux_map_and_write_2d_cama(DEF_hist_cama_vars%levdph, & - real(D2LEVDPH), file_hist, 'levdph', itime_in_file,'protected area depth','m') - !*** reset variable - CALL CMF_DIAG_RESET + CALL flux_map_and_write_2d_cama(DEF_hist_cama_vars%levdph, & + real(D2LEVDPH), file_hist, 'levdph', itime_in_file,'protected area depth','m') + + !*** reset variable + CALL CMF_DIAG_RESET END SUBROUTINE hist_out_cama SUBROUTINE hist_write_cama_time (filename, dataname, time, itime) - !DESCRIPTION - !=========== - ! This subrountine is used for writing time,longitude and latitude of cama-flood output using netcdf format. +!DESCRIPTION +!=========== + ! This subrountine is used for writing time,longitude and latitude of cama-flood output using netcdf format. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"ncio_create_file" : create netcdf file, see ncio_serial.F90 - !* :SUBROUTINE:"ncio_define_dimension" : define dimension of netcdf file, see ncio_serial.F90 - !* :SUBROUTINE:"ncio_write_serial" : write serial data into netcdf file (lon, lat), see ncio_serial.F90 - !* :SUBROUTINE:"ncio_write_time" : write time serial into netcdf file (lon, lat), see ncio_serial.F90 +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- + !* :SUBROUTINE:"ncio_create_file" : create netcdf file, see ncio_serial.F90 + !* :SUBROUTINE:"ncio_define_dimension" : define dimension of netcdf file, see ncio_serial.F90 + !* :SUBROUTINE:"ncio_write_serial" : write serial data into netcdf file (lon, lat), see ncio_serial.F90 + !* :SUBROUTINE:"ncio_write_time" : write time serial into netcdf file (lon, lat), see ncio_serial.F90 - !REVISION HISTORY - !---------------- - ! 2023.02.23 Zhongwang Wei @ SYSU +!REVISION HISTORY +!---------------- + ! 2023.02.23 Zhongwang Wei @ SYSU - USE MOD_SPMD_Task - USE MOD_NetCDFSerial - USE YOS_CMF_INPUT, ONLY: NX, NY - USE YOS_CMF_MAP, ONLY: D1LON, D1LAT + USE MOD_SPMD_Task + USE MOD_NetCDFSerial + USE YOS_CMF_INPUT, only: NX, NY + USE YOS_CMF_MAP, only: D1LON, D1LAT - IMPLICIT NONE + IMPLICIT NONE - character (len=*), intent(in) :: filename ! file name - character (len=*), intent(in) :: dataname ! data name - integer, intent(in) :: time(3) ! time (year, month, day) - integer, intent(out) :: itime ! number of time step + character (len=*), intent(in) :: filename ! file name + character (len=*), intent(in) :: dataname ! data name + integer, intent(in) :: time(3) ! time (year, month, day) + integer, intent(out) :: itime ! number of time step - ! Local variables - logical :: fexists + ! Local variables + logical :: fexists - if (p_is_master) then + IF (p_is_master) THEN inquire (file=filename, exist=fexists) - if (.not. fexists) then - call ncio_create_file (trim(filename)) + IF (.not. fexists) THEN + CALL ncio_create_file (trim(filename)) CALL ncio_define_dimension(filename, 'time', 0) - call ncio_define_dimension(filename,'lat_cama', NY) - call ncio_define_dimension(filename,'lon_cama', NX) - call ncio_write_serial (filename, 'lat_cama', D1LAT,'lat_cama') - call ncio_write_serial (filename, 'lon_cama', D1LON,'lon_cama') - endif + CALL ncio_define_dimension(filename,'lat_cama', NY) + CALL ncio_define_dimension(filename,'lon_cama', NX) + CALL ncio_write_serial (filename, 'lat_cama', D1LAT,'lat_cama') + CALL ncio_write_serial (filename, 'lon_cama', D1LON,'lon_cama') + ENDIF - call ncio_write_time (filename, dataname, time, itime) + CALL ncio_write_time (filename, dataname, time, itime) ENDIF END SUBROUTINE hist_write_cama_time @@ -480,45 +481,46 @@ END SUBROUTINE hist_write_cama_time SUBROUTINE flux_map_and_write_2d_cama (is_hist, & var_in, file_hist, varname, itime_in_file,longname,units) - !DESCRIPTION - !=========== - ! This subrountine is used for mapping cama-flood output using netcdf format. +!DESCRIPTION +!=========== + ! This subrountine is used for mapping cama-flood output using netcdf format. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"ncio_put_attr" : write netcdf attribute, see ncio_serial.F90 - !* :SUBROUTINE:"vecP2mapR" : convert 1D vector data -> 2D map data (REAL*4), CAMA/cmf_utils_mod.F90 - !* :SUBROUTINE:"ncio_write_serial_time" : define dimension of netcdf file, see ncio_serial.F90 +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- + !* :SUBROUTINE:"ncio_put_attr" : write netcdf attribute, see ncio_serial.F90 + !* :SUBROUTINE:"vecP2mapR" : convert 1D vector data -> 2D map data (real*4), CAMA/cmf_utils_mod.F90 + !* :SUBROUTINE:"ncio_write_serial_time" : define dimension of netcdf file, see ncio_serial.F90 + +!REVISION HISTORY +!---------------- + ! 2023.02.23 Zhongwang Wei @ SYSU - !REVISION HISTORY - !---------------- - ! 2023.02.23 Zhongwang Wei @ SYSU + USE MOD_Namelist + USE YOS_CMF_INPUT, only: NX, NY + USE YOS_CMF_MAP, only: NSEQALL + USE PARKIND1, only: JPRM + USE CMF_UTILS_MOD, only: vecP2mapR + USE MOD_NetCDFSerial, only: ncio_write_serial_time, ncio_put_attr - USE MOD_Namelist - USE YOS_CMF_INPUT, ONLY: NX, NY - USE YOS_CMF_MAP, ONLY: NSEQALL - USE PARKIND1, ONLY: JPRM - USE CMF_UTILS_MOD, ONLY: vecP2mapR - USE MOD_NetCDFSerial, ONLY: ncio_write_serial_time, ncio_put_attr + IMPLICIT NONE + logical, intent(in) :: is_hist + real(r8), intent(in) :: var_in (NSEQALL, 1) + character(len=*), intent(in) :: file_hist + character(len=*), intent(in) :: varname + integer, intent(in) :: itime_in_file - IMPLICIT NONE - logical, intent(in) :: is_hist - real(r8), INTENT(in) :: var_in (NSEQALL, 1) - character(len=*), intent(in) :: file_hist - character(len=*), intent(in) :: varname - integer, intent(in) :: itime_in_file - character (len=*), intent(in),optional :: longname - character (len=*), intent(in),optional :: units + character (len=*), intent(in),optional :: longname + character (len=*), intent(in),optional :: units - REAL(KIND=JPRM) :: R2OUT(NX,NY) + real(KIND=JPRM) :: R2OUT(NX,NY) - integer :: compress + integer :: compress - if (.not. is_hist) return + IF (.not. is_hist) RETURN CALL vecP2mapR(var_in,R2OUT) compress = DEF_HIST_COMPRESS_LEVEL - call ncio_write_serial_time (file_hist, varname, & + CALL ncio_write_serial_time (file_hist, varname, & itime_in_file, real(R2OUT), 'lon_cama', 'lat_cama', 'time',compress) IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) @@ -529,55 +531,55 @@ SUBROUTINE flux_map_and_write_2d_cama (is_hist, & END SUBROUTINE flux_map_and_write_2d_cama SUBROUTINE colm2cama_real8 (WorkerVar, IOVar, MasterVar) - !DESCRIPTION - !=========== - ! This subrountine is used for mapping colm output to cama input. - - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"allocate_block_data" : allocate data into block - - !REVISION HISTORY - !---------------- - ! 2023.02.23 Zhongwang Wei @ SYSU - - USE MOD_Precision - USE MOD_Namelist - USE MOD_TimeManager - USE MOD_SPMD_Task - USE MOD_Block - USE MOD_DataType - USE MOD_LandPatch - USE MOD_Mapping_Pset2Grid - USE MOD_Vars_TimeInvariants, ONLY : patchtype - USE MOD_Forcing, ONLY : forcmask - - IMPLICIT NONE - - real(r8), intent(inout) :: WorkerVar(:) !varialbe on worker processer - TYPE(block_data_real8_2d), intent(inout) :: IOVar !varialbe on IO processer - real(r8), INTENT(inout) :: MasterVar(:,:) !varialbe on master processer - - type(block_data_real8_2d) :: sumwt !sum of weight - real(r8), allocatable :: vectmp(:) !temporary vector - logical, allocatable :: filter(:) !filter for patchtype - !----------------------- Dummy argument -------------------------------- - integer :: xblk, yblk, xloc, yloc - integer :: iblk, jblk, idata, ixseg, iyseg - integer :: rmesg(3), smesg(3), isrc - real(r8), allocatable :: rbuf(:,:), sbuf(:,:), vdata(:,:) - integer :: xdsp, ydsp, xcnt, ycnt - - if(p_is_master)then +!DESCRIPTION +!=========== + ! This subrountine is used for mapping colm output to cama input. + +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- + !* :SUBROUTINE:"allocate_block_data" : allocate data into block + +!REVISION HISTORY +!---------------- + ! 2023.02.23 Zhongwang Wei @ SYSU + + USE MOD_Precision + USE MOD_Namelist + USE MOD_TimeManager + USE MOD_SPMD_Task + USE MOD_Block + USE MOD_DataType + USE MOD_LandPatch + USE MOD_Mapping_Pset2Grid + USE MOD_Vars_TimeInvariants, only : patchtype + USE MOD_Forcing, only : forcmask + + IMPLICIT NONE + + real(r8), intent(inout) :: WorkerVar(:) !varialbe on worker processer + type(block_data_real8_2d), intent(inout) :: IOVar !varialbe on IO processer + real(r8), intent(inout) :: MasterVar(:,:) !varialbe on master processer + + type(block_data_real8_2d) :: sumwt !sum of weight + real(r8), allocatable :: vectmp(:) !temporary vector + logical, allocatable :: filter(:) !filter for patchtype + !----------------------- Dummy argument -------------------------------- + integer :: xblk, yblk, xloc, yloc + integer :: iblk, jblk, idata, ixseg, iyseg + integer :: rmesg(3), smesg(3), isrc + integer :: xdsp, ydsp, xcnt, ycnt + real(r8), allocatable :: rbuf(:,:), sbuf(:,:), vdata(:,:) + + IF(p_is_master)THEN MasterVar(:,:) = spval - endif + ENDIF IF (p_is_worker) THEN - where (WorkerVar /= spval) + WHERE (WorkerVar /= spval) WorkerVar = WorkerVar / nacc endwhere - if (numpatch > 0) then + IF (numpatch > 0) THEN allocate (filter (numpatch)) allocate (vectmp (numpatch)) @@ -586,45 +588,45 @@ SUBROUTINE colm2cama_real8 (WorkerVar, IOVar, MasterVar) filter = filter .and. forcmask ENDIF vectmp (:) = 1. - end if + ENDIF ENDIF CALL mp2g_cama%map (WorkerVar, IOVar, spv = spval, msk = filter) - if (p_is_io) then - call allocate_block_data (gcama, sumwt) - end if + IF (p_is_io) THEN + CALL allocate_block_data (gcama, sumwt) + ENDIF - call mp2g_cama%map (vectmp, sumwt, spv = spval, msk = filter) + CALL mp2g_cama%map (vectmp, sumwt, spv = spval, msk = filter) - if (p_is_io) then - do yblk = 1, gblock%nyblk - do xblk = 1, gblock%nxblk - if (gblock%pio(xblk,yblk) == p_iam_glb) then - do yloc = 1, gcama%ycnt(yblk) - do xloc = 1, gcama%xcnt(xblk) + IF (p_is_io) THEN + DO yblk = 1, gblock%nyblk + DO xblk = 1, gblock%nxblk + IF (gblock%pio(xblk,yblk) == p_iam_glb) THEN + DO yloc = 1, gcama%ycnt(yblk) + DO xloc = 1, gcama%xcnt(xblk) - if (sumwt%blk(xblk,yblk)%val(xloc,yloc) > 0.00001) then + IF (sumwt%blk(xblk,yblk)%val(xloc,yloc) > 0.00001) THEN IF (IOVar%blk(xblk,yblk)%val(xloc,yloc) /= spval) THEN IOVar%blk(xblk,yblk)%val(xloc,yloc) & = IOVar%blk(xblk,yblk)%val(xloc,yloc) & / sumwt%blk(xblk,yblk)%val(xloc,yloc) ENDIF - else + ELSE IOVar%blk(xblk,yblk)%val(xloc,yloc) = spval - end if + ENDIF - end do - end do + ENDDO + ENDDO - end if - end do - end do - end if + ENDIF + ENDDO + ENDDO + ENDIF - if (p_is_master) then - do idata = 1, cama_gather%ndatablk - call mpi_recv (rmesg, 3, MPI_INTEGER, MPI_ANY_SOURCE, 10011, p_comm_glb, p_stat, p_err) + IF (p_is_master) THEN + DO idata = 1, cama_gather%ndatablk + CALL mpi_recv (rmesg, 3, MPI_INTEGER, MPI_ANY_SOURCE, 10011, p_comm_glb, p_stat, p_err) isrc = rmesg(1) ixseg = rmesg(2) iyseg = rmesg(3) @@ -635,20 +637,20 @@ SUBROUTINE colm2cama_real8 (WorkerVar, IOVar, MasterVar) ycnt = cama_gather%ysegs(iyseg)%cnt allocate (rbuf(xcnt,ycnt)) - call mpi_recv (rbuf, xcnt * ycnt, MPI_DOUBLE, & + CALL mpi_recv (rbuf, xcnt * ycnt, MPI_DOUBLE, & isrc, 10011, p_comm_glb, p_stat, p_err) MasterVar (xdsp+1:xdsp+xcnt,ydsp+1:ydsp+ycnt) = rbuf deallocate (rbuf) - end do + ENDDO - elseif (p_is_io) then - do iyseg = 1, cama_gather%nyseg - do ixseg = 1, cama_gather%nxseg + ELSEIF (p_is_io) THEN + DO iyseg = 1, cama_gather%nyseg + DO ixseg = 1, cama_gather%nxseg iblk = cama_gather%xsegs(ixseg)%blk jblk = cama_gather%ysegs(iyseg)%blk - if (gblock%pio(iblk,jblk) == p_iam_glb) then + IF (gblock%pio(iblk,jblk) == p_iam_glb) THEN xdsp = cama_gather%xsegs(ixseg)%bdsp ydsp = cama_gather%ysegs(iyseg)%bdsp xcnt = cama_gather%xsegs(ixseg)%cnt @@ -658,64 +660,65 @@ SUBROUTINE colm2cama_real8 (WorkerVar, IOVar, MasterVar) sbuf = IOVar%blk(iblk,jblk)%val(xdsp+1:xdsp+xcnt,ydsp+1:ydsp+ycnt) smesg = (/p_iam_glb, ixseg, iyseg/) - call mpi_send (smesg, 3, MPI_INTEGER, & + CALL mpi_send (smesg, 3, MPI_INTEGER, & p_root, 10011, p_comm_glb, p_err) - call mpi_send (sbuf, xcnt*ycnt, MPI_DOUBLE, & + CALL mpi_send (sbuf, xcnt*ycnt, MPI_DOUBLE, & p_root, 10011, p_comm_glb, p_err) deallocate (sbuf) - end if - end do - end do - end if + ENDIF + ENDDO + ENDDO + ENDIF - if (allocated(filter)) deallocate(filter) - if (allocated(vectmp)) deallocate(vectmp) + IF (allocated(filter)) deallocate(filter) + IF (allocated(vectmp)) deallocate(vectmp) END SUBROUTINE colm2cama_real8 SUBROUTINE cama2colm_real8 (MasterVar, IOVar, WorkerVar) - !DESCRIPTION - !=========== - ! This subrountine is used for mapping cama-flood output to colm input - - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- - !* :SUBROUTINE:"mg2p_cama%map_aweighted" : mapping grid to pset_type - - !REVISION HISTORY - !---------------- - ! 2023.02.23 Zhongwang Wei @ SYSU - ! 2022.? Zhongwang Wei and ShuPeng Zhang @ SYSU - - USE MOD_Precision - USE MOD_Namelist - USE MOD_TimeManager - USE MOD_SPMD_Task - USE MOD_Block - USE MOD_DataType - USE MOD_LandPatch - USE MOD_Mapping_Pset2Grid - USE MOD_Vars_TimeInvariants, ONLY : patchtype - USE MOD_Grid - - IMPLICIT NONE - - real(r8), INTENT(in) :: MasterVar (:,:) ! Variable at master processor - type(block_data_real8_2d), INTENT(inout) :: IOVar ! Variable at io processor - REAL(r8), intent(inout) :: WorkerVar (:) ! Variable at worker processor - - integer :: xblk, yblk, xloc, yloc - integer :: iblk, jblk, idata, ixseg, iyseg - integer :: rmesg(2), smesg(2), isrc, iproc - real(r8), allocatable :: rbuf(:,:), sbuf(:,:), vdata(:,:) - integer :: xdsp, ydsp, xcnt, ycnt - - if (p_is_master) then - do iyseg = 1, cama_gather%nyseg - do ixseg = 1, cama_gather%nxseg +!DESCRIPTION +!=========== + ! This subrountine is used for mapping cama-flood output to colm input + +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- + !* :SUBROUTINE:"mg2p_cama%map_aweighted" : mapping grid to pset_type + +!REVISION HISTORY + !---------------- + ! 2023.02.23 Zhongwang Wei @ SYSU + ! 2022.? Zhongwang Wei and ShuPeng Zhang @ SYSU + + USE MOD_Precision + USE MOD_Namelist + USE MOD_TimeManager + USE MOD_SPMD_Task + USE MOD_Block + USE MOD_DataType + USE MOD_LandPatch + USE MOD_Mapping_Pset2Grid + USE MOD_Vars_TimeInvariants, only : patchtype + USE MOD_Grid + + IMPLICIT NONE + + real(r8), intent(in) :: MasterVar (:,:) ! Variable at master processor + type(block_data_real8_2d), intent(inout) :: IOVar ! Variable at io processor + real(r8), intent(inout) :: WorkerVar (:) ! Variable at worker processor + + integer :: xblk , yblk , xloc , yloc + integer :: iblk , jblk , idata, ixseg, iyseg + integer :: rmesg(2), smesg(2), isrc , iproc + integer :: xdsp , ydsp , xcnt , ycnt + real(r8), allocatable :: rbuf(:,:), sbuf(:,:), vdata(:,:) + + + IF (p_is_master) THEN + DO iyseg = 1, cama_gather%nyseg + DO ixseg = 1, cama_gather%nxseg iblk = cama_gather%xsegs(ixseg)%blk jblk = cama_gather%ysegs(iyseg)%blk @@ -728,22 +731,22 @@ SUBROUTINE cama2colm_real8 (MasterVar, IOVar, WorkerVar) allocate (sbuf (xcnt,ycnt)) sbuf = MasterVar (xdsp+1:xdsp+xcnt, ydsp+1:ydsp+ycnt) smesg = (/ixseg, iyseg/) - call mpi_send (smesg, 2, MPI_INTEGER, & + CALL mpi_send (smesg, 2, MPI_INTEGER, & gblock%pio(iblk,jblk), 10000, p_comm_glb, p_err) - call mpi_send (sbuf, xcnt*ycnt, MPI_DOUBLE, & + CALL mpi_send (sbuf, xcnt*ycnt, MPI_DOUBLE, & gblock%pio(iblk,jblk), 10000, p_comm_glb, p_err) deallocate (sbuf) ENDIF - end do - end do + ENDDO + ENDDO DO iproc = 0, p_np_io-1 smesg = (/0, 0/) CALL mpi_send(smesg, 2, MPI_INTEGER, p_address_io(iproc), 10000, p_comm_glb, p_err) ENDDO - elseif (p_is_io) then + ELSEIF (p_is_io) THEN DO WHILE (.true.) - call mpi_recv (rmesg, 2, MPI_INTEGER, p_root, 10000, p_comm_glb, p_stat, p_err) + CALL mpi_recv (rmesg, 2, MPI_INTEGER, p_root, 10000, p_comm_glb, p_stat, p_err) ixseg = rmesg(1) iyseg = rmesg(2) @@ -756,15 +759,15 @@ SUBROUTINE cama2colm_real8 (MasterVar, IOVar, WorkerVar) ycnt = cama_gather%ysegs(iyseg)%cnt allocate (rbuf(xcnt,ycnt)) - call mpi_recv (rbuf, xcnt*ycnt, MPI_DOUBLE, & + CALL mpi_recv (rbuf, xcnt*ycnt, MPI_DOUBLE, & p_root, 10000, p_comm_glb, p_stat, p_err) IOVar%blk(iblk,jblk)%val(xdsp+1:xdsp+xcnt,ydsp+1:ydsp+ycnt)= rbuf deallocate (rbuf) ELSE - exit + EXIT ENDIF - end do - endif + ENDDO + ENDIF CALL mg2p_cama%map_aweighted (IOVar, WorkerVar) !mapping grid to pset_type @@ -772,5 +775,5 @@ END SUBROUTINE cama2colm_real8 #endif -END module MOD_CaMa_Vars +END MODULE MOD_CaMa_Vars ! ----- EOP --------- diff --git a/CaMa/src/MOD_CaMa_colmCaMa.F90 b/CaMa/src/MOD_CaMa_colmCaMa.F90 index 9f3f540e..dbdb0903 100644 --- a/CaMa/src/MOD_CaMa_colmCaMa.F90 +++ b/CaMa/src/MOD_CaMa_colmCaMa.F90 @@ -3,178 +3,178 @@ MODULE MOD_CaMa_colmCaMa #if(defined CaMa_Flood) !DESCRIPTION !=========== -! This MODULE is the coupler for the colm and CaMa-Flood model. + ! This MODULE is the coupler for the colm and CaMa-Flood model. !ANCILLARY FUNCTIONS AND SUBROUTINES !------------------- -!* :SUBROUTINE:"colm_CaMa_init" : Initialization of the coupler -!* :SUBROUTINE:"colm_CaMa_drv" : Coupling between colm and CaMa-Flood -!* :SUBROUTINE:"colm_CaMa_exit" : Finalization of the coupler -!* :SUBROUTINE:"get_fldinfo" : Get floodplain information from CaMa-Flood model -!* :SUBROUTINE:"get_fldevp" : calculate floodplain evaporation + !* :SUBROUTINE:"colm_CaMa_init" : Initialization of the coupler + !* :SUBROUTINE:"colm_CaMa_drv" : Coupling between colm and CaMa-Flood + !* :SUBROUTINE:"colm_CaMa_exit" : Finalization of the coupler + !* :SUBROUTINE:"get_fldinfo" : Get floodplain information from CaMa-Flood model + !* :SUBROUTINE:"get_fldevp" : calculate floodplain evaporation !REVISION HISTORY !---------------- -! 2023.02.21 Zhongwang Wei @ SYSU -! 2021.12.02 Zhongwang Wei @ SYSU -! 2020.10.01 Zhongwang Wei @ SYSU - -use MOD_Namelist -USE MOD_CaMa_Vars -USE PARKIND1, ONLY: JPRB, JPRM, JPIM -USE CMF_DRV_CONTROL_MOD, ONLY: CMF_DRV_INPUT, CMF_DRV_INIT, CMF_DRV_END -USE CMF_DRV_ADVANCE_MOD, ONLY: CMF_DRV_ADVANCE -USE CMF_CTRL_FORCING_MOD, ONLY: CMF_FORCING_GET, CMF_FORCING_PUT -USE CMF_CTRL_OUTPUT_MOD, ONLY: CMF_OUTPUT_INIT,CMF_OUTPUT_END,NVARSOUT,VAROUT -USE YOS_CMF_INPUT, ONLY: NXIN, NYIN, DT,DTIN,IFRQ_INP,LLEAPYR,NX,NY,RMIS,DMIS -USE MOD_Precision, ONLY: r8,r4 -USE YOS_CMF_INPUT , ONLY: LROSPLIT,LWEVAP,LWINFILT -USE MOD_SPMD_Task -USE CMF_CTRL_TIME_MOD -USE MOD_Vars_Global, ONLY : spval -USE MOD_Vars_1DFluxes -USE MOD_Qsadv -USE CMF_CTRL_RESTART_MOD -IMPLICIT NONE -!----------------------- Dummy argument -------------------------------- -INTEGER I,J -INTEGER(KIND=JPIM) :: ISTEPX ! total time step -INTEGER(KIND=JPIM) :: ISTEPADV ! time step to be advanced within DRV_ADVANCE -REAL(KIND=JPRB),ALLOCATABLE :: ZBUFF(:,:,:) ! Buffer to store forcing runoff - -INTERFACE colm_CaMa_init - MODULE PROCEDURE colm_CaMa_init -END INTERFACE - -INTERFACE colm_CaMa_drv - MODULE PROCEDURE colm_CaMa_drv -END INTERFACE + ! 2023.02.21 Zhongwang Wei @ SYSU + ! 2021.12.02 Zhongwang Wei @ SYSU + ! 2020.10.01 Zhongwang Wei @ SYSU + + USE MOD_Namelist + USE MOD_CaMa_Vars + USE PARKIND1, only: JPRB, JPRM, JPIM + USE CMF_DRV_CONTROL_MOD, only: CMF_DRV_INPUT, CMF_DRV_INIT, CMF_DRV_END + USE CMF_DRV_ADVANCE_MOD, only: CMF_DRV_ADVANCE + USE CMF_CTRL_FORCING_MOD, only: CMF_FORCING_GET, CMF_FORCING_PUT + USE CMF_CTRL_OUTPUT_MOD, only: CMF_OUTPUT_INIT,CMF_OUTPUT_END,NVARSOUT,VAROUT + USE YOS_CMF_INPUT, only: NXIN, NYIN, DT,DTIN,IFRQ_INP,LLEAPYR,NX,NY,RMIS,DMIS + USE MOD_Precision, only: r8,r4 + USE YOS_CMF_INPUT , only: LROSPLIT,LWEVAP,LWINFILT + USE MOD_SPMD_Task + USE CMF_CTRL_TIME_MOD + USE MOD_Vars_Global, only: spval + USE MOD_Vars_1DFluxes + USE MOD_Qsadv + USE CMF_CTRL_RESTART_MOD + IMPLICIT NONE + !----------------------- Dummy argument -------------------------------- + integer I,J + integer(KIND=JPIM) :: ISTEPX ! total time step + integer(KIND=JPIM) :: ISTEPADV ! time step to be advanced within DRV_ADVANCE + real(KIND=JPRB),ALLOCATABLE :: ZBUFF(:,:,:) ! Buffer to store forcing runoff + + INTERFACE colm_CaMa_init + MODULE PROCEDURE colm_CaMa_init + END INTERFACE + + INTERFACE colm_CaMa_drv + MODULE PROCEDURE colm_CaMa_drv + END INTERFACE INTERFACE colm_CaMa_exit MODULE PROCEDURE colm_CaMa_exit - end INTERFACE + END INTERFACE CONTAINS -SUBROUTINE colm_CaMa_init + SUBROUTINE colm_CaMa_init USE MOD_LandPatch - USE YOS_CMF_TIME, ONLY: YYYY0 + USE YOS_CMF_TIME, only: YYYY0 IMPLICIT NONE !** local variables - INTEGER i,j - INTEGER(KIND=JPIM) :: JF + integer i,j + integer(KIND=JPIM) :: JF #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - IF(p_is_master)THEN - !Namelist handling - CALL CMF_DRV_INPUT - !get the time information from colm namelist - DT = IFRQ_INP*3600 ! time step of model simulation [sec] - DTIN = IFRQ_INP*3600 ! time step of input data [sec] - SYEAR = DEF_simulation_time%start_year ! start year - SMON = DEF_simulation_time%start_month ! start month - SDAY = DEF_simulation_time%start_day ! start day - SHOUR = DEF_simulation_time%start_sec/3600 ! start hour - EYEAR = DEF_simulation_time%end_year ! end year - EMON = DEF_simulation_time%end_month ! end month - EDAY = DEF_simulation_time%end_day ! end day - EHOUR = DEF_simulation_time%end_sec/3600 ! end hour - LLEAPYR = DEF_forcing%leapyear ! leap year flag + IF(p_is_master)THEN + !Namelist handling + CALL CMF_DRV_INPUT + !get the time information from colm namelist + DT = IFRQ_INP*3600 ! time step of model simulation [sec] + DTIN = IFRQ_INP*3600 ! time step of input data [sec] + SYEAR = DEF_simulation_time%start_year ! start year + SMON = DEF_simulation_time%start_month ! start month + SDAY = DEF_simulation_time%start_day ! start day + SHOUR = DEF_simulation_time%start_sec/3600 ! start hour + EYEAR = DEF_simulation_time%end_year ! end year + EMON = DEF_simulation_time%end_month ! end month + EDAY = DEF_simulation_time%end_day ! end day + EHOUR = DEF_simulation_time%end_sec/3600 ! end hour + LLEAPYR = DEF_forcing%leapyear ! leap year flag - CALL system('mkdir -p ' // trim(DEF_dir_restart)//'/CaMa') - - - !----------------------- Dummy argument -------------------------------- - YYYY0 = SYEAR - RMIS = spval - DMIS = spval - - CALL CMF_DRV_INIT !INITIALIZATION - !Initialize varialbes to be outputed from variable list - DO JF=1,NVARSOUT - SELECT CASE (VAROUT(JF)%CVNAME) - CASE ('rivout') ! river discharge [m3/s] - DEF_hist_cama_vars%rivout=.true. - CASE ('rivsto') ! river storage [m3] - DEF_hist_cama_vars%rivsto=.true. - CASE ('rivdph') ! river depth [m] - DEF_hist_cama_vars%rivdph=.true. - CASE ('rivvel') ! river velocity [m/s] - DEF_hist_cama_vars%rivvel=.true. - CASE ('fldout') ! floodplain discharge [m3/s] - DEF_hist_cama_vars%fldout=.true. - CASE ('fldsto') ! floodplain storage [m3] - DEF_hist_cama_vars%fldsto=.true. - CASE ('flddph') ! floodplain depth [m] - DEF_hist_cama_vars%flddph=.true. - CASE ('fldfrc') ! floodplain fraction (0-1) - DEF_hist_cama_vars%fldfrc=.true. - CASE ('fldare') ! floodplain area [m2] - DEF_hist_cama_vars%fldare=.true. - CASE ('sfcelv') ! water surface elevation [m] - DEF_hist_cama_vars%sfcelv=.true. - CASE ('totout') ! total discharge(river+floodplain) [m3/s] - DEF_hist_cama_vars%totout=.true. - CASE ('outflw') ! compatibility for previous file name =totout - DEF_hist_cama_vars%outflw=.true. - CASE ('totsto') ! total storage(river+floodplain) [m3] - DEF_hist_cama_vars%totsto=.true. - CASE ('storge') ! compatibility for previous file name =totsto - DEF_hist_cama_vars%storge=.true. - CASE ('pthflw') ! bifurcation channel discharge [m3/s] - DEF_hist_cama_vars%pthflw=.true. - CASE ('pthout') ! net bifurcation discharge [m3/s] - DEF_hist_cama_vars%pthout=.true. - CASE ('maxflw') ! daily maximum discharge [m3/s] - DEF_hist_cama_vars%maxflw=.true. - CASE ('maxdph') ! daily maximum depth [m] - DEF_hist_cama_vars%maxdph=.true. - CASE ('maxsto') ! daily maximum storage [m3] - DEF_hist_cama_vars%maxsto=.true. - !TODO: check the difference between gwsto and gdwsto - CASE ('gwsto') ! ground water storage [m3] - DEF_hist_cama_vars%gwsto=.true. - CASE ('gdwsto') ! ground water storage [m3] - DEF_hist_cama_vars%gdwsto=.true. - CASE ('gwout') ! ground water discharge [m3/s] - DEF_hist_cama_vars%gwout=.true. - !TODO: check the difinition of gdwrtn, runoff, rofsfc, rofsub - CASE ('gdwrtn') ! Ground water return flow [m3/s] - DEF_hist_cama_vars%gdwrtn=.true. - CASE ('runoff') ! total runoff [m3/s] !! compatibility for previous file name - DEF_hist_cama_vars%runoff=.true. - CASE ('runoffsub') ! subsurface runoff [m3/s] !! compatibility for previous file name - DEF_hist_cama_vars%runoffsub=.true. - CASE ('rofsfc') ! surface runoff [m3/s] !! compatibility for previous file name - DEF_hist_cama_vars%rofsfc=.true. - CASE ('rofsub') ! input sub-surface runoff [m3/s] - DEF_hist_cama_vars%rofsub=.true. - CASE ('damsto') ! reservoir storage [m3] - DEF_hist_cama_vars%damsto=.true. - CASE ('daminf') ! reservoir inflow [m3/s] - DEF_hist_cama_vars%daminf=.true. - CASE ('levsto') !flood storage in protected side (storage betwen river & levee) [m3] - DEF_hist_cama_vars%levsto=.true. - CASE ('levdph') !flood depth in protected side [m] - DEF_hist_cama_vars%levdph=.true. - CASE ('wevap') ! input inundation Evaporation [m] - IF (LWEVAP) then - DEF_hist_cama_vars%wevap=.true. - ELSE - DEF_hist_cama_vars%wevap=.false. - ENDIF - CASE ('winfilt') ! input inundation re-infiltrition [m] - IF (LWINFILT) then - DEF_hist_cama_vars%winfilt=.true. - else - DEF_hist_cama_vars%winfilt=.false. - ENDIF - CASE DEFAULT - stop - END SELECT - end do - ENDIF + CALL system('mkdir -p ' // trim(DEF_dir_restart)//'/CaMa') + + + !----------------------- Dummy argument -------------------------------- + YYYY0 = SYEAR + RMIS = spval + DMIS = spval + + CALL CMF_DRV_INIT !INITIALIZATION + !Initialize varialbes to be outputed from variable list + DO JF=1,NVARSOUT + SELECT CASE (VAROUT(JF)%CVNAME) + CASE ('rivout') ! river discharge [m3/s] + DEF_hist_cama_vars%rivout=.true. + CASE ('rivsto') ! river storage [m3] + DEF_hist_cama_vars%rivsto=.true. + CASE ('rivdph') ! river depth [m] + DEF_hist_cama_vars%rivdph=.true. + CASE ('rivvel') ! river velocity [m/s] + DEF_hist_cama_vars%rivvel=.true. + CASE ('fldout') ! floodplain discharge [m3/s] + DEF_hist_cama_vars%fldout=.true. + CASE ('fldsto') ! floodplain storage [m3] + DEF_hist_cama_vars%fldsto=.true. + CASE ('flddph') ! floodplain depth [m] + DEF_hist_cama_vars%flddph=.true. + CASE ('fldfrc') ! floodplain fraction (0-1) + DEF_hist_cama_vars%fldfrc=.true. + CASE ('fldare') ! floodplain area [m2] + DEF_hist_cama_vars%fldare=.true. + CASE ('sfcelv') ! water surface elevation [m] + DEF_hist_cama_vars%sfcelv=.true. + CASE ('totout') ! total discharge(river+floodplain) [m3/s] + DEF_hist_cama_vars%totout=.true. + CASE ('outflw') ! compatibility for previous file name =totout + DEF_hist_cama_vars%outflw=.true. + CASE ('totsto') ! total storage(river+floodplain) [m3] + DEF_hist_cama_vars%totsto=.true. + CASE ('storge') ! compatibility for previous file name =totsto + DEF_hist_cama_vars%storge=.true. + CASE ('pthflw') ! bifurcation channel discharge [m3/s] + DEF_hist_cama_vars%pthflw=.true. + CASE ('pthout') ! net bifurcation discharge [m3/s] + DEF_hist_cama_vars%pthout=.true. + CASE ('maxflw') ! daily maximum discharge [m3/s] + DEF_hist_cama_vars%maxflw=.true. + CASE ('maxdph') ! daily maximum depth [m] + DEF_hist_cama_vars%maxdph=.true. + CASE ('maxsto') ! daily maximum storage [m3] + DEF_hist_cama_vars%maxsto=.true. + !TODO: check the difference between gwsto and gdwsto + CASE ('gwsto') ! ground water storage [m3] + DEF_hist_cama_vars%gwsto=.true. + CASE ('gdwsto') ! ground water storage [m3] + DEF_hist_cama_vars%gdwsto=.true. + CASE ('gwout') ! ground water discharge [m3/s] + DEF_hist_cama_vars%gwout=.true. + !TODO: check the difinition of gdwrtn, runoff, rofsfc, rofsub + CASE ('gdwrtn') ! Ground water return flow [m3/s] + DEF_hist_cama_vars%gdwrtn=.true. + CASE ('runoff') ! total runoff [m3/s] !! compatibility for previous file name + DEF_hist_cama_vars%runoff=.true. + CASE ('runoffsub') ! subsurface runoff [m3/s] !! compatibility for previous file name + DEF_hist_cama_vars%runoffsub=.true. + CASE ('rofsfc') ! surface runoff [m3/s] !! compatibility for previous file name + DEF_hist_cama_vars%rofsfc=.true. + CASE ('rofsub') ! input sub-surface runoff [m3/s] + DEF_hist_cama_vars%rofsub=.true. + CASE ('damsto') ! reservoir storage [m3] + DEF_hist_cama_vars%damsto=.true. + CASE ('daminf') ! reservoir inflow [m3/s] + DEF_hist_cama_vars%daminf=.true. + CASE ('levsto') !flood storage in protected side (storage betwen river & levee) [m3] + DEF_hist_cama_vars%levsto=.true. + CASE ('levdph') !flood depth in protected side [m] + DEF_hist_cama_vars%levdph=.true. + CASE ('wevap') ! input inundation Evaporation [m] + IF (LWEVAP) THEN + DEF_hist_cama_vars%wevap=.true. + ELSE + DEF_hist_cama_vars%wevap=.false. + ENDIF + CASE ('winfilt') ! input inundation re-infiltrition [m] + IF (LWINFILT) THEN + DEF_hist_cama_vars%winfilt=.true. + ELSE + DEF_hist_cama_vars%winfilt=.false. + ENDIF + CASE DEFAULT + STOP + END SELECT + ENDDO + ENDIF !Broadcast the variables to all the processors CALL mpi_bcast (NX , 1, MPI_INTEGER, p_root, p_comm_glb, p_err) ! number of grid points in x-direction of CaMa-Flood @@ -183,27 +183,27 @@ SUBROUTINE colm_CaMa_init CALL mpi_bcast (LWEVAP , 1, MPI_LOGICAL, p_root, p_comm_glb, p_err) ! switch for inundation evaporation CALL mpi_bcast (LWINFILT , 1, MPI_LOGICAL, p_root, p_comm_glb, p_err) ! switch for inundation re-infiltration - !Allocate the data structure for cama + !allocate the data structure for cama CALL gcama%define_by_ndims (NX, NY) !define the data structure for cama CALL mp2g_cama%build (landpatch, gcama) !build the mapping between cama and mpi CALL mg2p_cama%build (gcama, landpatch) CALL cama_gather%set (gcama) - !Allocate the cama-flood related variable for accumulation + !allocate the cama-flood related variable for accumulation CALL allocate_2D_cama_Fluxes (gcama) !allocate the 2D variables CALL allocate_acc_cama_Fluxes () !allocate the accumulation variables CALL FLUSH_acc_cama_fluxes () !initialize the accumulation variables !Only master processor allocate the 2D variables IF (p_is_master) THEN - ALLOCATE (runoff_2d (NX,NY)) - ALLOCATE (fevpg_2d (NX,NY)) - ALLOCATE (finfg_2d (NX,NY)) - !Allocate data buffer for input forcing, flood fraction and flood depth - ALLOCATE (ZBUFF(NX,NY,4)) - ALLOCATE (fldfrc_tmp(NX,NY)) - ALLOCATE (flddepth_tmp(NX,NY)) + allocate (runoff_2d (NX,NY)) + allocate (fevpg_2d (NX,NY)) + allocate (finfg_2d (NX,NY)) + !allocate data buffer for input forcing, flood fraction and flood depth + allocate (ZBUFF(NX,NY,4)) + allocate (fldfrc_tmp(NX,NY)) + allocate (flddepth_tmp(NX,NY)) !Initialize the data buffer for input forcing, flood fraction and flood depth runoff_2d(:,:) = 0.0D0 !runoff in master processor fevpg_2d(:,:) = 0.0D0 !evaporation in master processor @@ -212,419 +212,419 @@ SUBROUTINE colm_CaMa_init fldfrc_tmp(:,:) = 0.0D0 !flood fraction in master processor flddepth_tmp(:,:) = 0.0D0 !flood depth in master processor ENDIF - !Allocate the cama-flood related variable in worker processors + !allocate the cama-flood related variable in worker processors IF (p_is_worker) THEN - ALLOCATE (flddepth_cama(numpatch)) !flood depth in worker processors - ALLOCATE (fldfrc_cama(numpatch)) !flood fraction in worker processors - ALLOCATE (fevpg_fld(numpatch)) !evaporation in worker processors - ALLOCATE (finfg_fld(numpatch)) !re-infiltration in worker processors + allocate (flddepth_cama(numpatch)) !flood depth in worker processors + allocate (fldfrc_cama(numpatch)) !flood fraction in worker processors + allocate (fevpg_fld(numpatch)) !evaporation in worker processors + allocate (finfg_fld(numpatch)) !re-infiltration in worker processors flddepth_cama(:) = 0.0D0 fldfrc_cama(:) = 0.0D0 fevpg_fld(:) = 0.0D0 finfg_fld(:) = 0.0D0 -end IF -end SUBROUTINE colm_CaMa_init + ENDIF + END SUBROUTINE colm_CaMa_init !#################################################################### -SUBROUTINE colm_cama_drv(idate_sec) + SUBROUTINE colm_cama_drv(idate_sec) IMPLICIT NONE - INTEGER, intent(in) :: idate_sec ! calendar (year, julian day, seconds) - !Accumulate cama-flood related flux variables - CALL accumulate_cama_fluxes - ! If the time is the same as the input time step of cama-flood - IF (MOD(idate_sec,3600*int(IFRQ_INP))==0) THEN + integer, intent(in) :: idate_sec ! calendar (year, julian day, seconds) + !Accumulate cama-flood related flux variables + CALL accumulate_cama_fluxes + ! If the time is the same as the input time step of cama-flood + IF (MOD(idate_sec,3600*int(IFRQ_INP))==0) THEN #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - ! Prepare sending the accumulated runoff flux varilble to cama model (master processor to worker processors) - CALL colm2cama_real8 (a_rnof_cama, f_rnof_cama, runoff_2d) + ! Prepare sending the accumulated runoff flux varilble to cama model (master processor to worker processors) + CALL colm2cama_real8 (a_rnof_cama, f_rnof_cama, runoff_2d) - ! Prepare sending the accumulated inundation evaporation flux to cama model (master processor to worker processors) - ! only if the inundation evaporation is turned on - IF (LWEVAP) THEN + ! Prepare sending the accumulated inundation evaporation flux to cama model (master processor to worker processors) + ! only if the inundation evaporation is turned on + IF (LWEVAP) THEN #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - CALL colm2cama_real8 (a_fevpg_fld, f_fevpg_fld, fevpg_2d) - ENDIF - ! Prepare sending the accumulated inundation re-infiltrition flux to cama model (master processor to worker processors) - ! only if the inundation re-infiltrition is turned on - IF (LWINFILT) THEN + CALL colm2cama_real8 (a_fevpg_fld, f_fevpg_fld, fevpg_2d) + ENDIF + ! Prepare sending the accumulated inundation re-infiltrition flux to cama model (master processor to worker processors) + ! only if the inundation re-infiltrition is turned on + IF (LWINFILT) THEN #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - CALL colm2cama_real8 (a_finfg_fld, f_finfg_fld, finfg_2d) - ENDIF + CALL colm2cama_real8 (a_finfg_fld, f_finfg_fld, finfg_2d) + ENDIF #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif ! Reset the accumulation variables - CALL flush_acc_cama_fluxes + CALL flush_acc_cama_fluxes #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - ! Initialize the variables unit for cama-flood input - IF(p_is_master)THEN - DO i = 1,NX ! cama_gather%ginfo%nlon - DO j = 1, NY ! cama_gather%ginfo%nlat - ZBUFF(i,j,1)=runoff_2d(i,j)/1000.0D0 ! mm/s -->m/s - ZBUFF(i,j,2)=0.0D0 - IF (LWEVAP) THEN - ZBUFF(i,j,3)=fevpg_2d(i,j)/1000.0D0 ! mm/s -->m/s - ELSE - ZBUFF(i,j,3)=0.0D0 - ENDIF - IF (LWINFILT) THEN - ZBUFF(i,j,4)=finfg_2d(i,j)/1000.0D0 !mm/s -->m/s - ELSE - ZBUFF(i,j,4)=0.0D0 - ENDIF + ! Initialize the variables unit for cama-flood input + IF(p_is_master)THEN + DO i = 1,NX ! cama_gather%ginfo%nlon + DO j = 1, NY ! cama_gather%ginfo%nlat + ZBUFF(i,j,1)=runoff_2d(i,j)/1000.0D0 ! mm/s -->m/s + ZBUFF(i,j,2)=0.0D0 + IF (LWEVAP) THEN + ZBUFF(i,j,3)=fevpg_2d(i,j)/1000.0D0 ! mm/s -->m/s + ELSE + ZBUFF(i,j,3)=0.0D0 + ENDIF + IF (LWINFILT) THEN + ZBUFF(i,j,4)=finfg_2d(i,j)/1000.0D0 !mm/s -->m/s + ELSE + ZBUFF(i,j,4)=0.0D0 + ENDIF + ENDDO ENDDO - ENDDO - - ! Simulating the hydrodynamics in continental-scale rivers - ! ---------------------------------------------------------------------- - ! Get the time step of cama-flood simulation - ISTEPADV=INT(DTIN/DT,JPIM) - ! Interporlate variables & send to CaMa-Flood - CALL CMF_FORCING_PUT(ZBUFF) - ! Advance CaMa-Flood model for ISTEPADV - CALL CMF_DRV_ADVANCE(ISTEPADV) - ! Get the flood depth and flood fraction from cama-flood model - IF (LWINFILT .or. LWEVAP) THEN - CALL get_fldinfo() + ! Simulating the hydrodynamics in continental-scale rivers + ! ---------------------------------------------------------------------- + + ! Get the time step of cama-flood simulation + ISTEPADV=INT(DTIN/DT,JPIM) + ! Interporlate variables & send to CaMa-Flood + CALL CMF_FORCING_PUT(ZBUFF) + ! Advance CaMa-Flood model for ISTEPADV + CALL CMF_DRV_ADVANCE(ISTEPADV) + ! Get the flood depth and flood fraction from cama-flood model + IF (LWINFILT .or. LWEVAP) THEN + CALL get_fldinfo() + ENDIF ENDIF - ENDIF - ! Send the flood depth and flood fraction from master processors to worker processors - IF (LWINFILT .or. LWEVAP) THEN + ! Send the flood depth and flood fraction from master processors to worker processors + IF (LWINFILT .or. LWEVAP) THEN #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - CALL cama2colm_real8 (flddepth_tmp, f_flddepth_cama, flddepth_cama)! unit [m] + CALL cama2colm_real8 (flddepth_tmp, f_flddepth_cama, flddepth_cama)! unit [m] #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - CALL cama2colm_real8 (fldfrc_tmp, f_fldfrc_cama, fldfrc_cama ) ! unit [%] + CALL cama2colm_real8 (fldfrc_tmp, f_fldfrc_cama, fldfrc_cama ) ! unit [%] #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - flddepth_cama=flddepth_cama*1000.D0 !m --> mm - fldfrc_cama=fldfrc_cama/100.D0 !% --> [0-1] + flddepth_cama=flddepth_cama*1000.D0 !m --> mm + fldfrc_cama=fldfrc_cama/100.D0 !% --> [0-1] + ENDIF ENDIF - ENDIF -END SUBROUTINE colm_cama_drv + END SUBROUTINE colm_cama_drv -SUBROUTINE colm_cama_exit + SUBROUTINE colm_cama_exit IMPLICIT NONE #ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) + CALL mpi_barrier (p_comm_glb, p_err) #endif - ! finalize CaMa-Flood - CALL deallocate_acc_cama_Fluxes () - IF(p_is_master)THEN ! finalize CaMa-Flood - DEALLOCATE(ZBUFF) - DEALLOCATE (runoff_2d) - DEALLOCATE (fevpg_2d) - DEALLOCATE (finfg_2d) - ENDIF - IF (p_is_worker) THEN - DEALLOCATE (flddepth_cama) - DEALLOCATE (fldfrc_cama) - DEALLOCATE (fevpg_fld) - DEALLOCATE (finfg_fld) - end IF -END SUBROUTINE colm_cama_exit - -SUBROUTINE colm_cama_write_restart(idate, lc_year, site, dir_restart) + CALL deallocate_acc_cama_Fluxes () + IF(p_is_master)THEN + ! finalize CaMa-Flood + deallocate(ZBUFF) + deallocate (runoff_2d) + deallocate (fevpg_2d) + deallocate (finfg_2d) + ENDIF + IF (p_is_worker) THEN + deallocate (flddepth_cama) + deallocate (fldfrc_cama) + deallocate (fevpg_fld) + deallocate (finfg_fld) + ENDIF + END SUBROUTINE colm_cama_exit + + + SUBROUTINE colm_cama_write_restart(idate, lc_year, site, dir_restart) IMPLICIT NONE integer, intent(in) :: idate(3) integer, intent(in) :: lc_year !year of land cover type data character(LEN=*), intent(in) :: site character(LEN=*), intent(in) :: dir_restart - ! Local variables + ! Local variables character(LEN=256) :: file_restart character(len=14) :: cdate character(len=256) :: cyear !character for lc_year - ! land cover type year - write(cyear,'(i4.4)') lc_year - write(cdate,'(i4.4,"-",i3.3,"-",i5.5)') idate(1), idate(2), idate(3) - CRESTDIR = trim(DEF_dir_restart)// '/CaMa'//'/'//trim(cdate)//'/' - CALL system('mkdir -p ' // trim(CRESTDIR)) - call CMF_RESTART_WRITE() + ! land cover type year + write(cyear,'(i4.4)') lc_year + write(cdate,'(i4.4,"-",i3.3,"-",i5.5)') idate(1), idate(2), idate(3) + CRESTDIR = trim(DEF_dir_restart)// '/CaMa'//'/'//trim(cdate)//'/' + CALL system('mkdir -p ' // trim(CRESTDIR)) + CALL CMF_RESTART_WRITE() -END SUBROUTINE colm_cama_write_restart + END SUBROUTINE colm_cama_write_restart !#################################################################### -SUBROUTINE get_fldinfo() - !DESCRIPTION - !=========== + SUBROUTINE get_fldinfo() +!DESCRIPTION +!=========== ! This subrountine prepare cama output variables for inundation evaporation and re-infiltration - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- !* :SUBROUTINE:"vecD2mapD" : convert 1D vector data -> 2D map data (REAL*8), see CAMA/CMF_UTILS_MOD.F90 - - !REVISION HISTORY - !---------------- +!REVISION HISTORY +!---------------- ! 2020.10.01 Zhongwang Wei @ SYSU - USE YOS_CMF_INPUT, ONLY: NX, NY !grid number - USE YOS_CMF_DIAG, ONLY: D2FLDDPH,D2FLDFRC !1D vector data of flood depth and flood fraction - USE CMF_UTILS_MOD, ONLY: vecD2mapD !convert 1D vector data -> 2D map data (REAL*8) + USE YOS_CMF_INPUT, only: NX, NY !grid number + USE YOS_CMF_DIAG, only: D2FLDDPH,D2FLDFRC !1D vector data of flood depth and flood fraction + USE CMF_UTILS_MOD, only: vecD2mapD !convert 1D vector data -> 2D map data (REAL*8) IMPLICIT NONE !----------------------- Dummy argument -------------------------------- - INTEGER i,j - - !================================================ - !! convert 1Dvector to 2Dmap - CALL vecD2mapD(D2FLDFRC,flddepth_tmp) !! MPI node data is gathered by VEC2MAP - CALL vecD2mapD(D2FLDDPH,fldfrc_tmp) !! MPI node data is gathered by VEC2MAP - - do i = 1, NX - do j = 1, NY - IF (flddepth_tmp(i,j) .LT. 0.0) flddepth_tmp(i,j) = 0.0 - IF (fldfrc_tmp(i,j) .LT. 0.0) fldfrc_tmp(i,j) = 0.0 - IF (fldfrc_tmp(i,j) .GT. 100.0) fldfrc_tmp(i,j) = 100.0 !!If fraction is larger than 100%, it is set to 100%. + integer i,j + + !================================================ + !! convert 1Dvector to 2Dmap + CALL vecD2mapD(D2FLDFRC,flddepth_tmp) !! MPI node data is gathered by VEC2MAP + CALL vecD2mapD(D2FLDDPH,fldfrc_tmp) !! MPI node data is gathered by VEC2MAP + + DO i = 1, NX + DO j = 1, NY + IF (flddepth_tmp(i,j) .lt. 0.0) flddepth_tmp(i,j) = 0.0 + IF (fldfrc_tmp(i,j) .lt. 0.0) fldfrc_tmp(i,j) = 0.0 + IF (fldfrc_tmp(i,j) .gt. 100.0) fldfrc_tmp(i,j) = 100.0 !!If fraction is larger than 100%, it is set to 100%. + ENDDO ENDDO - ENDDO -END SUBROUTINE get_fldinfo - -SUBROUTINE get_fldevp (hu,ht,hq,us,vs,tm,qm,rhoair,psrf,tssea,& - hpbl, & - taux,tauy,fseng,fevpg,tref,qref,z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq) - !DESCRIPTION - !=========== + END SUBROUTINE get_fldinfo + + SUBROUTINE get_fldevp (hu,ht,hq,us,vs,tm,qm,rhoair,psrf,tssea,& + hpbl, & + taux,tauy,fseng,fevpg,tref,qref,z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq) +!DESCRIPTION +!=========== ! This subrountine compute surface fluxes, derviatives, and exchange coefficiants ! This is the main SUBROUTINE to execute the calculation of thermal processes ! and surface fluxes - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- !* :SUBROUTINE:"qsadv" : ! computes saturation mixing ratio and change in saturation !* :SUBROUTINE:" moninobukini" : ! initialzation of Monin-Obukhov length, see MOD_FrictionVelocity.F90 !* :SUBROUTINE:" moninobuk" : ! calculation of friction velocity, relation for potential temperature ! and humidity profiles of surface boundary layer,see MOD_FrictionVelocity.F90 - !REVISION HISTORY - !---------------- +!REVISION HISTORY +!---------------- ! 2023.05.05 Shaofeng Liu @ SYSU: - ! add option to call moninobuk_leddy, the LargeEddy + ! add option to CALL moninobuk_leddy, the LargeEddy ! surface turbulence scheme (LZD2022); make a proper update of um. ! 2020.10.01 Zhongwang Wei @ SYSU ! 2002.08.30 Yongjiu Dai @ BNU ! 1999.09.15 Yongjiu Dai @ BNU USE MOD_Precision - USE MOD_Const_Physical, ONLY : cpair,rgas,vonkar,grav + USE MOD_Const_Physical, only : cpair,rgas,vonkar,grav USE MOD_FrictionVelocity USE MOD_TurbulenceLEddy IMPLICIT NONE - REAL(r8), INTENT(in) :: hu ! agcm reference height of wind [m] - REAL(r8), INTENT(in) :: ht ! agcm reference height of temperature [m] - REAL(r8), INTENT(in) :: hq ! agcm reference height of humidity [m] - REAL(r8), INTENT(in) :: us ! wind component in eastward direction [m/s] - REAL(r8), INTENT(in) :: vs ! wind component in northward direction [m/s] - REAL(r8), INTENT(in) :: tm ! temperature at agcm reference height [kelvin] - REAL(r8), INTENT(in) :: qm ! specific humidity at agcm reference height [kg/kg] - REAL(r8), INTENT(in) :: rhoair ! density air [kg/m3] - REAL(r8), INTENT(in) :: psrf ! atmosphere pressure at the surface [pa] [not used] - REAL(r8), INTENT(in) :: tssea ! inundation surface temperature [K]-->set to tgrnd - REAL(r8), INTENT(in) :: hpbl ! atmospheric boundary layer height [m] - REAL(r8), INTENT(out) :: taux ! wind stress: E-W [kg/m/s**2] - REAL(r8), INTENT(out) :: tauy ! wind stress: N-S [kg/m/s**2] - REAL(r8), INTENT(out) :: fseng ! sensible heat flux from ground [mm/s] - REAL(r8), INTENT(out) :: fevpg ! evaporation heat flux from ground [mm/s] - REAL(r8), INTENT(out) :: tref ! 2 m height air temperature [kelvin] - REAL(r8), INTENT(out) :: qref ! 2 m height air humidity [?] - REAL(r8), INTENT(out) :: z0m ! effective roughness [m] - REAL(r8), INTENT(out) :: zol ! dimensionless height (z/L) used in Monin-Obukhov theory - REAL(r8), INTENT(out) :: rib ! bulk Richardson number in surface layer - REAL(r8), INTENT(out) :: ustar ! friction velocity [m/s] - REAL(r8), INTENT(out) :: tstar ! temperature scaling parameter - REAL(r8), INTENT(out) :: qstar ! moisture scaling parameter - REAL(r8), INTENT(out) :: fm ! integral of profile function for momentum - REAL(r8), INTENT(out) :: fh ! integral of profile function for heat - REAL(r8), INTENT(out) :: fq ! integral of profile function for moisture + real(r8), intent(in) :: hu ! agcm reference height of wind [m] + real(r8), intent(in) :: ht ! agcm reference height of temperature [m] + real(r8), intent(in) :: hq ! agcm reference height of humidity [m] + real(r8), intent(in) :: us ! wind component in eastward direction [m/s] + real(r8), intent(in) :: vs ! wind component in northward direction [m/s] + real(r8), intent(in) :: tm ! temperature at agcm reference height [kelvin] + real(r8), intent(in) :: qm ! specific humidity at agcm reference height [kg/kg] + real(r8), intent(in) :: rhoair ! density air [kg/m3] + real(r8), intent(in) :: psrf ! atmosphere pressure at the surface [pa] [not used] + real(r8), intent(in) :: tssea ! inundation surface temperature [K]-->set to tgrnd + real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] + real(r8), intent(out) :: taux ! wind stress: E-W [kg/m/s**2] + real(r8), intent(out) :: tauy ! wind stress: N-S [kg/m/s**2] + real(r8), intent(out) :: fseng ! sensible heat flux from ground [mm/s] + real(r8), intent(out) :: fevpg ! evaporation heat flux from ground [mm/s] + real(r8), intent(out) :: tref ! 2 m height air temperature [kelvin] + real(r8), intent(out) :: qref ! 2 m height air humidity [?] + real(r8), intent(out) :: z0m ! effective roughness [m] + real(r8), intent(out) :: zol ! dimensionless height (z/L) used in Monin-Obukhov theory + real(r8), intent(out) :: rib ! bulk Richardson number in surface layer + real(r8), intent(out) :: ustar ! friction velocity [m/s] + real(r8), intent(out) :: tstar ! temperature scaling parameter + real(r8), intent(out) :: qstar ! moisture scaling parameter + real(r8), intent(out) :: fm ! integral of profile function for momentum + real(r8), intent(out) :: fh ! integral of profile function for heat + real(r8), intent(out) :: fq ! integral of profile function for moisture !----------------------- Dummy argument -------------------------------- - INTEGER i - INTEGER niters ! maximum number of iterations for surface temperature - INTEGER iter ! iteration index - INTEGER nmozsgn ! number of times moz changes sign - - REAL(r8) :: beta ! coefficient of conective velocity [-] - REAL(r8) :: displax ! zero-displacement height [m] - REAL(r8) :: dth ! diff of virtual temp. between ref. height and surface - REAL(r8) :: dqh ! diff of humidity between ref. height and surface - REAL(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface - REAL(r8) :: eg ! water vapor pressure at temperature T [Pa] - REAL(r8) :: degdT ! d(eg)/dT - REAL(r8) :: obu ! monin-obukhov length [m] - REAL(r8) :: obuold ! monin-obukhov length from previous iteration - REAL(r8) :: qsatg ! ground saturated specific humidity [kg/kg] - REAL(r8) :: qsatgdT ! d(qsatg)/dT - REAL(r8) :: ram ! aerodynamical resistance [s/m] - REAL(r8) :: rah ! thermal resistance [s/m] - REAL(r8) :: raw ! moisture resistance [s/m] - REAL(r8) :: raih ! temporary variable [kg/m2/s] - REAL(r8) :: raiw ! temporary variable [kg/m2/s] - REAL(r8) :: fh2m ! relation for temperature at 2m - REAL(r8) :: fq2m ! relation for specific humidity at 2m - REAL(r8) :: fm10m ! integral of profile function for momentum at 10m - REAL(r8) :: thm ! intermediate variable (tm+0.0098*ht) - REAL(r8) :: th ! potential temperature (kelvin) - REAL(r8) :: thv ! virtual potential temperature (kelvin) - REAL(r8) :: thvstar ! virtual potential temperature scaling parameter - REAL(r8) :: um ! wind speed including the stablity effect [m/s] - REAL(r8) :: ur ! wind speed at reference height [m/s] - REAL(r8) :: visa ! kinematic viscosity of dry air [m2/s] - REAL(r8) :: wc ! convective velocity [m/s] - REAL(r8) :: wc2 ! wc**2 - REAL(r8) :: xt ! ----> temporary variables - REAL(r8) :: xq ! ----> temporary variables - REAL(r8) :: zii ! convective boundary height [m] - REAL(r8) :: zldis ! reference height "minus" zero displacement heght [m] - REAL(r8) :: z0mg ! roughness length over ground, momentum [m] - REAL(r8) :: z0hg ! roughness length over ground, sensible heat [m] - REAL(r8) :: z0qg ! roughness length over ground, latent heat [m] - - REAL, parameter :: zsice = 0.04 ! sea ice aerodynamic roughness length [m] - - !----------------------------------------------------------------------- - ! Potential temperatur at the reference height - beta = 1. ! - (in computing W_*) - zii = 1000. ! m (pbl height) - - !----------------------------------------------------------------------- - ! Compute sensible and latent fluxes and their derivatives with respect - ! to surface temperature using surface temperatures from previous time step. - !----------------------------------------------------------------------- - ! Initialization variables - nmozsgn = 0 - obuold = 0. - ! Calculate saturation mixing ratio and change in saturation - CALL qsadv(tssea,psrf,eg,degdT,qsatg,qsatgdT) - - ! Potential temperatur at the reference height - thm = tm + 0.0098*ht ! intermediate variable equivalent to - ! tm*(pgcm/psrf)**(rgas/cpair) - th = tm*(100000./psrf)**(rgas/cpair) ! potential T - thv = th*(1.+0.61*qm) ! virtual potential T - ur = max(0.1,sqrt(us*us+vs*vs)) ! limit set to 0.1 - - dth = thm-tssea ! diff of potential temp. between ref. height and surface - dqh = qm-qsatg ! diff of humidity between ref. height and surface - dthv = dth*(1.+0.61*qm)+0.61*th*dqh ! diff of vir. poten. temp. between ref. height and surface - !TODO: check if this is correct, inundation may occur over vegetated surface - zldis = hu-0. ! reference height "minus" zero displacement heght - - ! Kinematic viscosity of dry air (m2/s)- Andreas (1989) CRREL Rep. 89-11 - visa=1.326e-5*(1.+6.542e-3*tm + 8.301e-6*tm**2 - 4.84e-9*tm**3) - - ! Loop to obtain initial and good ustar and zo - ustar=0.06 ! initial value of ustar - wc=0.5 ! initial value of wc - !initial value of um - IF(dthv.ge.0.) THEN - um=max(ur,0.1) - else - um=sqrt(ur*ur+wc*wc) - ENDIF - ! initial value of z0mg and ustar - do i=1,5 - z0mg=0.013*ustar*ustar/grav+0.11*visa/ustar - ustar=vonkar*um/log(zldis/z0mg) - ENDDO - ! - CALL moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0mg,um,obu) - - ! Evaluated stability-dependent variables using moz from prior iteration - niters = 10 - displax = 0. - - !---------------------------------------------------------------- - ITERATION : do iter = 1, niters ! begin stability iteration - !---------------------------------------------------------------- - ! Compute stability-dependent variables - z0mg = 0.013*ustar*ustar/grav + 0.11*visa/ustar - xq = 2.67*(ustar*z0mg/visa)**0.25 - 2.57 - xt= xq - z0qg=z0mg/exp(xq) - z0hg=z0mg/exp(xt) - !calculation of friction velocity, relation for potential temperature - if (DEF_USE_CBL_HEIGHT) then - CALL moninobuk_leddy(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um, hpbl, & - ustar,fh2m,fq2m,fm10m,fm,fh,fq) - else - CALL moninobuk(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um,& - ustar,fh2m,fq2m,fm10m,fm,fh,fq) - endif - !get qstar and tstar - tstar = vonkar/fh*dth - qstar = vonkar/fq*dqh - - thvstar=tstar*(1.+0.61*qm)+0.61*th*qstar - zol=zldis*vonkar*grav*thvstar/(ustar**2*thv) !z/L - IF(zol >= 0.) THEN ! stable - zol = min(2.,max(zol,1.e-6)) - else ! unstable - zol = max(-100.,min(zol,-1.e-6)) - ENDIF - obu = zldis/zol - - IF(zol >= 0.)THEN - um = max(ur,0.1) !wind speed at reference height - else - if (DEF_USE_CBL_HEIGHT) then !//TODO: Shaofeng, 2023.05.18 - zii = max(5.*hu,hpbl) - endif !//TODO: Shaofeng, 2023.05.18 - wc = (-grav*ustar*thvstar*zii/thv)**(1./3.) !convective velocity scale - wc2 = beta*beta*(wc*wc) !convective velocity scale squared - um = sqrt(ur*ur+wc2) !wind speed with convective velocity scale - ENDIF - - IF (obuold*obu < 0.) nmozsgn = nmozsgn+1 - IF(nmozsgn >= 4) EXIT - - obuold = obu - - !---------------------------------------------------------------- - ENDDO ITERATION ! end stability iteration - !---------------------------------------------------------------- - - ! Get derivative of fluxes with repect to ground temperature - ram = 1./(ustar*ustar/um) - rah = 1./(vonkar/fh*ustar) - raw = 1./(vonkar/fq*ustar) - - raih = rhoair*cpair/rah - raiw = rhoair/raw - !cgrnds = raih - !cgrndl = raiw*qsatgdT - - rib = min(5.,zol*ustar**2/(vonkar**2/fh*um**2)) - - ! Surface fluxes of momentum, sensible and latent - ! using ground temperatures from previous time step - taux = -rhoair*us/ram - tauy = -rhoair*vs/ram - - fseng = -raih*dth - fevpg = -raiw*dqh - !fsena = fseng - !fevpa = fevpg - - ! 2 m height air temperature - tref = thm + vonkar/fh*dth * (fh2m/vonkar - fh/vonkar) - qref = qm + vonkar/fq*dqh * (fq2m/vonkar - fq/vonkar) - z0m = z0mg - end SUBROUTINE get_fldevp + integer i + integer niters ! maximum number of iterations for surface temperature + integer iter ! iteration index + integer nmozsgn ! number of times moz changes sign + + real(r8) :: beta ! coefficient of conective velocity [-] + real(r8) :: displax ! zero-displacement height [m] + real(r8) :: dth ! diff of virtual temp. between ref. height and surface + real(r8) :: dqh ! diff of humidity between ref. height and surface + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: eg ! water vapor pressure at temperature T [Pa] + real(r8) :: degdT ! d(eg)/dT + real(r8) :: obu ! monin-obukhov length [m] + real(r8) :: obuold ! monin-obukhov length from previous iteration + real(r8) :: qsatg ! ground saturated specific humidity [kg/kg] + real(r8) :: qsatgdT ! d(qsatg)/dT + real(r8) :: ram ! aerodynamical resistance [s/m] + real(r8) :: rah ! thermal resistance [s/m] + real(r8) :: raw ! moisture resistance [s/m] + real(r8) :: raih ! temporary variable [kg/m2/s] + real(r8) :: raiw ! temporary variable [kg/m2/s] + real(r8) :: fh2m ! relation for temperature at 2m + real(r8) :: fq2m ! relation for specific humidity at 2m + real(r8) :: fm10m ! integral of profile function for momentum at 10m + real(r8) :: thm ! intermediate variable (tm+0.0098*ht) + real(r8) :: th ! potential temperature (kelvin) + real(r8) :: thv ! virtual potential temperature (kelvin) + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: um ! wind speed including the stablity effect [m/s] + real(r8) :: ur ! wind speed at reference height [m/s] + real(r8) :: visa ! kinematic viscosity of dry air [m2/s] + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: wc2 ! wc**2 + real(r8) :: xt ! ----> temporary variables + real(r8) :: xq ! ----> temporary variables + real(r8) :: zii ! convective boundary height [m] + real(r8) :: zldis ! reference height "minus" zero displacement heght [m] + real(r8) :: z0mg ! roughness length over ground, momentum [m] + real(r8) :: z0hg ! roughness length over ground, sensible heat [m] + real(r8) :: z0qg ! roughness length over ground, latent heat [m] + + real, parameter :: zsice = 0.04 ! sea ice aerodynamic roughness length [m] + + !----------------------------------------------------------------------- + ! Potential temperatur at the reference height + beta = 1. ! - (in computing W_*) + zii = 1000. ! m (pbl height) + + !----------------------------------------------------------------------- + ! Compute sensible and latent fluxes and their derivatives with respect + ! to surface temperature using surface temperatures from previous time step. + !----------------------------------------------------------------------- + ! Initialization variables + nmozsgn = 0 + obuold = 0. + ! Calculate saturation mixing ratio and change in saturation + CALL qsadv(tssea,psrf,eg,degdT,qsatg,qsatgdT) + + ! Potential temperatur at the reference height + thm = tm + 0.0098*ht ! intermediate variable equivalent to + ! tm*(pgcm/psrf)**(rgas/cpair) + th = tm*(100000./psrf)**(rgas/cpair) ! potential T + thv = th*(1.+0.61*qm) ! virtual potential T + ur = max(0.1,sqrt(us*us+vs*vs)) ! limit set to 0.1 + + dth = thm-tssea ! diff of potential temp. between ref. height and surface + dqh = qm-qsatg ! diff of humidity between ref. height and surface + dthv = dth*(1.+0.61*qm)+0.61*th*dqh ! diff of vir. poten. temp. between ref. height and surface + !TODO: check if this is correct, inundation may occur over vegetated surface + zldis = hu-0. ! reference height "minus" zero displacement heght + + ! Kinematic viscosity of dry air (m2/s)- Andreas (1989) CRREL Rep. 89-11 + visa=1.326e-5*(1.+6.542e-3*tm + 8.301e-6*tm**2 - 4.84e-9*tm**3) + + ! Loop to obtain initial and good ustar and zo + ustar=0.06 ! initial value of ustar + wc=0.5 ! initial value of wc + !initial value of um + IF(dthv.ge.0.) THEN + um=max(ur,0.1) + ELSE + um=sqrt(ur*ur+wc*wc) + ENDIF + ! initial value of z0mg and ustar + DO i=1,5 + z0mg=0.013*ustar*ustar/grav+0.11*visa/ustar + ustar=vonkar*um/log(zldis/z0mg) + ENDDO + ! + CALL moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0mg,um,obu) + + ! Evaluated stability-dependent variables using moz from prior iteration + niters = 10 + displax = 0. + + !---------------------------------------------------------------- + ITERATION : DO iter = 1, niters ! begin stability iteration + !---------------------------------------------------------------- + ! Compute stability-dependent variables + z0mg = 0.013*ustar*ustar/grav + 0.11*visa/ustar + xq = 2.67*(ustar*z0mg/visa)**0.25 - 2.57 + xt = xq + z0qg = z0mg/exp(xq) + z0hg = z0mg/exp(xt) + !calculation of friction velocity, relation for potential temperature + IF (DEF_USE_CBL_HEIGHT) THEN + CALL moninobuk_leddy(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um, hpbl, & + ustar,fh2m,fq2m,fm10m,fm,fh,fq) + ELSE + CALL moninobuk(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um,& + ustar,fh2m,fq2m,fm10m,fm,fh,fq) + ENDIF + !get qstar and tstar + tstar = vonkar/fh*dth + qstar = vonkar/fq*dqh + + thvstar=tstar*(1.+0.61*qm)+0.61*th*qstar + zol=zldis*vonkar*grav*thvstar/(ustar**2*thv) !z/L + IF(zol >= 0.) THEN ! stable + zol = min(2.,max(zol,1.e-6)) + ELSE ! unstable + zol = max(-100.,min(zol,-1.e-6)) + ENDIF + obu = zldis/zol + + IF(zol >= 0.)THEN + um = max(ur,0.1) !wind speed at reference height + ELSE + IF (DEF_USE_CBL_HEIGHT) THEN !//TODO: Shaofeng, 2023.05.18 + zii = max(5.*hu,hpbl) + ENDIF !//TODO: Shaofeng, 2023.05.18 + wc = (-grav*ustar*thvstar*zii/thv)**(1./3.) !convective velocity scale + wc2 = beta*beta*(wc*wc) !convective velocity scale squared + um = sqrt(ur*ur+wc2) !wind speed with convective velocity scale + ENDIF + + IF (obuold*obu < 0.) nmozsgn = nmozsgn+1 + IF(nmozsgn >= 4) EXIT + + obuold = obu + + !---------------------------------------------------------------- + ENDDO ITERATION ! end stability iteration + !---------------------------------------------------------------- + + ! Get derivative of fluxes with repect to ground temperature + ram = 1./(ustar*ustar/um) + rah = 1./(vonkar/fh*ustar) + raw = 1./(vonkar/fq*ustar) + + raih = rhoair*cpair/rah + raiw = rhoair/raw + !cgrnds = raih + !cgrndl = raiw*qsatgdT + + rib = min(5.,zol*ustar**2/(vonkar**2/fh*um**2)) + + ! Surface fluxes of momentum, sensible and latent + ! using ground temperatures from previous time step + taux = -rhoair*us/ram + tauy = -rhoair*vs/ram + + fseng = -raih*dth + fevpg = -raiw*dqh + !fsena = fseng + !fevpa = fevpg + + ! 2 m height air temperature + tref = thm + vonkar/fh*dth * (fh2m/vonkar - fh/vonkar) + qref = qm + vonkar/fq*dqh * (fq2m/vonkar - fq/vonkar) + z0m = z0mg + END SUBROUTINE get_fldevp #endif -end MODULE MOD_CaMa_colmCaMa +END MODULE MOD_CaMa_colmCaMa diff --git a/CaMa/src/cmf_calc_diag_mod.F90 b/CaMa/src/cmf_calc_diag_mod.F90 index d96607d9..0072a03e 100755 --- a/CaMa/src/cmf_calc_diag_mod.F90 +++ b/CaMa/src/cmf_calc_diag_mod.F90 @@ -19,9 +19,9 @@ MODULE CMF_CALC_DIAG_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRM, JPRB -USE YOS_CMF_INPUT, ONLY: LOGNAM -IMPLICIT NONE + USE PARKIND1, only: JPIM, JPRM, JPRB + USE YOS_CMF_INPUT, only: LOGNAM + IMPLICIT NONE CONTAINS !#################################################################### ! -- CMF_DIAG_AVE_MAX : Add / Max of diagnostic variables at time step @@ -29,82 +29,82 @@ MODULE CMF_CALC_DIAG_MOD ! -- CMF_DIAG_RESET : Reset Diagnostic Variables (Average & Maximum ) ! !#################################################################### -SUBROUTINE CMF_DIAG_AVEMAX -USE YOS_CMF_INPUT, ONLY: DT, LPTHOUT, LDAMOUT, LWEVAP,LWINFILT -USE YOS_CMF_MAP, ONLY: NSEQALL, NPTHOUT,D2GRAREA -USE YOS_CMF_PROG, ONLY: D2RIVOUT, D2FLDOUT, D1PTHFLW, D2GDWRTN, & - & D2RUNOFF, D2ROFSUB, P2DAMINF -USE YOS_CMF_DIAG, ONLY: D2OUTFLW, D2RIVVEL, D2PTHOUT, D2PTHINF, & - & D2RIVDPH, D2STORGE, D2WEVAPEX, D2WINFILTEX, NADD, & - & D2RIVOUT_AVG, D2FLDOUT_AVG, D1PTHFLW_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & - & D2OUTFLW_AVG, D2RIVVEL_AVG, D2PTHOUT_AVG, D2DAMINF_AVG, D2WEVAPEX_AVG, D2WINFILTEX_AVG, & - & D2OUTFLW_MAX, D2RIVDPH_MAX, D2STORGE_MAX + SUBROUTINE CMF_DIAG_AVEMAX + USE YOS_CMF_INPUT, only: DT, LPTHOUT, LDAMOUT, LWEVAP,LWINFILT + USE YOS_CMF_MAP, only: NSEQALL, NPTHOUT,D2GRAREA + USE YOS_CMF_PROG, only: D2RIVOUT, D2FLDOUT, D1PTHFLW, D2GDWRTN, & + & D2RUNOFF, D2ROFSUB, P2DAMINF + USE YOS_CMF_DIAG, only: D2OUTFLW, D2RIVVEL, D2PTHOUT, D2PTHINF, & + & D2RIVDPH, D2STORGE, D2WEVAPEX, D2WINFILTEX, NADD, & + & D2RIVOUT_AVG, D2FLDOUT_AVG, D1PTHFLW_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, & + & D2OUTFLW_AVG, D2RIVVEL_AVG, D2PTHOUT_AVG, D2DAMINF_AVG, D2WEVAPEX_AVG, D2WINFILTEX_AVG, & + & D2OUTFLW_MAX, D2RIVDPH_MAX, D2STORGE_MAX #ifdef sediment -USE YOS_CMF_INPUT, ONLY: LSEDOUT -USE yos_cmf_sed, ONLY: d2rivout_sed, d2rivvel_sed, sadd_riv + USE YOS_CMF_INPUT, only: LSEDOUT + USE yos_cmf_sed, only: d2rivout_sed, d2rivvel_sed, sadd_riv #endif -IMPLICIT NONE -INTEGER(KIND=JPIM),SAVE :: ISEQ, IPTH -!==================== -NADD=NADD+DT -!$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - D2RIVOUT_AVG(ISEQ,1)=D2RIVOUT_AVG(ISEQ,1)+D2RIVOUT(ISEQ,1)*DT - D2FLDOUT_AVG(ISEQ,1)=D2FLDOUT_AVG(ISEQ,1)+D2FLDOUT(ISEQ,1)*DT - D2RIVVEL_AVG(ISEQ,1)=D2RIVVEL_AVG(ISEQ,1)+D2RIVVEL(ISEQ,1)*DT - D2OUTFLW_AVG(ISEQ,1)=D2OUTFLW_AVG(ISEQ,1)+D2OUTFLW(ISEQ,1)*DT - - D2PTHOUT_AVG(ISEQ,1)=D2PTHOUT_AVG(ISEQ,1)+D2PTHOUT(ISEQ,1)*DT-D2PTHINF(ISEQ,1)*DT - - D2GDWRTN_AVG(ISEQ,1)=D2GDWRTN_AVG(ISEQ,1)+D2GDWRTN(ISEQ,1)*DT - D2RUNOFF_AVG(ISEQ,1)=D2RUNOFF_AVG(ISEQ,1)+D2RUNOFF(ISEQ,1)*DT - D2ROFSUB_AVG(ISEQ,1)=D2ROFSUB_AVG(ISEQ,1)+D2ROFSUB(ISEQ,1)*DT - - D2OUTFLW_MAX(ISEQ,1)=max( D2OUTFLW_MAX(ISEQ,1), abs(D2OUTFLW(ISEQ,1)) ) - D2RIVDPH_MAX(ISEQ,1)=max( D2RIVDPH_MAX(ISEQ,1), D2RIVDPH(ISEQ,1) ) - D2STORGE_MAX(ISEQ,1)=max( D2STORGE_MAX(ISEQ,1), D2STORGE(ISEQ,1) ) - - IF( LWEVAP )THEN - D2WEVAPEX_AVG(ISEQ,1)= (D2WEVAPEX_AVG(ISEQ,1) +D2WEVAPEX(ISEQ,1)*DT) /D2GRAREA(ISEQ,1) - ENDIF - IF( LWINFILT )THEN - D2WINFILTEX_AVG(ISEQ,1)= (D2WINFILTEX_AVG(ISEQ,1) +D2WINFILTEX(ISEQ,1)*DT)/D2GRAREA(ISEQ,1) - ENDIF -END DO + IMPLICIT NONE + integer(KIND=JPIM),SAVE :: ISEQ, IPTH + !==================== + NADD=NADD+DT + !$OMP PARALLEL DO + DO ISEQ=1, NSEQALL + D2RIVOUT_AVG(ISEQ,1)=D2RIVOUT_AVG(ISEQ,1)+D2RIVOUT(ISEQ,1)*DT + D2FLDOUT_AVG(ISEQ,1)=D2FLDOUT_AVG(ISEQ,1)+D2FLDOUT(ISEQ,1)*DT + D2RIVVEL_AVG(ISEQ,1)=D2RIVVEL_AVG(ISEQ,1)+D2RIVVEL(ISEQ,1)*DT + D2OUTFLW_AVG(ISEQ,1)=D2OUTFLW_AVG(ISEQ,1)+D2OUTFLW(ISEQ,1)*DT + + D2PTHOUT_AVG(ISEQ,1)=D2PTHOUT_AVG(ISEQ,1)+D2PTHOUT(ISEQ,1)*DT-D2PTHINF(ISEQ,1)*DT + + D2GDWRTN_AVG(ISEQ,1)=D2GDWRTN_AVG(ISEQ,1)+D2GDWRTN(ISEQ,1)*DT + D2RUNOFF_AVG(ISEQ,1)=D2RUNOFF_AVG(ISEQ,1)+D2RUNOFF(ISEQ,1)*DT + D2ROFSUB_AVG(ISEQ,1)=D2ROFSUB_AVG(ISEQ,1)+D2ROFSUB(ISEQ,1)*DT + + D2OUTFLW_MAX(ISEQ,1)=max( D2OUTFLW_MAX(ISEQ,1), abs(D2OUTFLW(ISEQ,1)) ) + D2RIVDPH_MAX(ISEQ,1)=max( D2RIVDPH_MAX(ISEQ,1), D2RIVDPH(ISEQ,1) ) + D2STORGE_MAX(ISEQ,1)=max( D2STORGE_MAX(ISEQ,1), D2STORGE(ISEQ,1) ) + + IF( LWEVAP )THEN + D2WEVAPEX_AVG(ISEQ,1)= (D2WEVAPEX_AVG(ISEQ,1) +D2WEVAPEX(ISEQ,1)*DT) /D2GRAREA(ISEQ,1) + ENDIF + IF( LWINFILT )THEN + D2WINFILTEX_AVG(ISEQ,1)= (D2WINFILTEX_AVG(ISEQ,1) +D2WINFILTEX(ISEQ,1)*DT)/D2GRAREA(ISEQ,1) + ENDIF + ENDDO !$OMP END PARALLEL DO !! loop for optional variable (separated for computational efficiency) -IF( LDAMOUT )THEN - !$OMP PARALLEL DO - DO ISEQ=1, NSEQALL - D2DAMINF_AVG(ISEQ,1)=D2DAMINF_AVG(ISEQ,1)+P2DAMINF(ISEQ,1)*DT - END DO - !$OMP END PARALLEL DO -ENDIF - -IF( LPTHOUT )THEN - !$OMP PARALLEL DO - DO IPTH=1, NPTHOUT - D1PTHFLW_AVG(IPTH,:)=D1PTHFLW_AVG(IPTH,:)+D1PTHFLW(IPTH,:)*DT - END DO - !$OMP END PARALLEL DO -ENDIF + IF( LDAMOUT )THEN +!$OMP PARALLEL DO + DO ISEQ=1, NSEQALL + D2DAMINF_AVG(ISEQ,1)=D2DAMINF_AVG(ISEQ,1)+P2DAMINF(ISEQ,1)*DT + ENDDO +!$OMP END PARALLEL DO + ENDIF + + IF( LPTHOUT )THEN +!$OMP PARALLEL DO + DO IPTH=1, NPTHOUT + D1PTHFLW_AVG(IPTH,:)=D1PTHFLW_AVG(IPTH,:)+D1PTHFLW(IPTH,:)*DT + ENDDO +!$OMP END PARALLEL DO + ENDIF #ifdef sediment -!calculate average rivout and rivvel for sediment timestep -IF( LSEDOUT )THEN - sadd_riv = sadd_riv + DT - !$OMP PARALLEL DO - DO ISEQ=1, NSEQALL - d2rivout_sed(ISEQ) = d2rivout_sed(ISEQ)+D2RIVOUT(ISEQ,1)*DT - d2rivvel_sed(ISEQ) = d2rivvel_sed(ISEQ)+D2RIVVEL(ISEQ,1)*DT - END DO - !$OMP END PARALLEL DO -ENDIF + !calculate average rivout and rivvel for sediment timestep + IF( LSEDOUT )THEN + sadd_riv = sadd_riv + DT +!$OMP PARALLEL DO + DO ISEQ=1, NSEQALL + d2rivout_sed(ISEQ) = d2rivout_sed(ISEQ)+D2RIVOUT(ISEQ,1)*DT + d2rivvel_sed(ISEQ) = d2rivvel_sed(ISEQ)+D2RIVVEL(ISEQ,1)*DT + ENDDO +!$OMP END PARALLEL DO + ENDIF #endif -END SUBROUTINE CMF_DIAG_AVEMAX + END SUBROUTINE CMF_DIAG_AVEMAX !#################################################################### @@ -112,15 +112,15 @@ END SUBROUTINE CMF_DIAG_AVEMAX !#################################################################### -SUBROUTINE CMF_DIAG_AVERAGE -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JHHMM -USE YOS_CMF_DIAG, ONLY: D2DIAG_AVG, D1PTHFLW_AVG, NADD -IMPLICIT NONE + SUBROUTINE CMF_DIAG_AVERAGE + USE YOS_CMF_TIME, only: JYYYYMMDD, JHHMM + USE YOS_CMF_DIAG, only: D2DIAG_AVG, D1PTHFLW_AVG, NADD + IMPLICIT NONE !================================================ -WRITE(LOGNAM,*) "CMF::DIAG_AVERAGE: time-average", NADD, JYYYYMMDD, JHHMM -D2DIAG_AVG(:,:,:) = D2DIAG_AVG(:,:,:) /DBLE(NADD) -D1PTHFLW_AVG(:,:) = D1PTHFLW_AVG(:,:) /DBLE(NADD) -END SUBROUTINE CMF_DIAG_AVERAGE + write(LOGNAM,*) "CMF::DIAG_AVERAGE: time-average", NADD, JYYYYMMDD, JHHMM + D2DIAG_AVG(:,:,:) = D2DIAG_AVG(:,:,:) /DBLE(NADD) + D1PTHFLW_AVG(:,:) = D1PTHFLW_AVG(:,:) /DBLE(NADD) + END SUBROUTINE CMF_DIAG_AVERAGE !#################################################################### @@ -128,17 +128,17 @@ END SUBROUTINE CMF_DIAG_AVERAGE !#################################################################### -SUBROUTINE CMF_DIAG_RESET -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JHHMM -USE YOS_CMF_DIAG, ONLY: D2DIAG_AVG, D1PTHFLW_AVG, D2DIAG_MAX, NADD -IMPLICIT NONE + SUBROUTINE CMF_DIAG_RESET + USE YOS_CMF_TIME, only: JYYYYMMDD, JHHMM + USE YOS_CMF_DIAG, only: D2DIAG_AVG, D1PTHFLW_AVG, D2DIAG_MAX, NADD + IMPLICIT NONE !================================================ -WRITE(LOGNAM,*) "CMF::DIAG_AVERAGE: reset", JYYYYMMDD, JHHMM -NADD=0 -D2DIAG_AVG(:,:,:) = 0._JPRB -D1PTHFLW_AVG(:,:) = 0._JPRB -D2DIAG_MAX(:,:,:) = 0._JPRB -END SUBROUTINE CMF_DIAG_RESET + write(LOGNAM,*) "CMF::DIAG_AVERAGE: reset", JYYYYMMDD, JHHMM + NADD=0 + D2DIAG_AVG(:,:,:) = 0._JPRB + D1PTHFLW_AVG(:,:) = 0._JPRB + D2DIAG_MAX(:,:,:) = 0._JPRB + END SUBROUTINE CMF_DIAG_RESET !#################################################################### END MODULE CMF_CALC_DIAG_MOD diff --git a/CaMa/src/cmf_calc_fldstg_mod.F90 b/CaMa/src/cmf_calc_fldstg_mod.F90 index 5613cfdb..e0c5abf6 100755 --- a/CaMa/src/cmf_calc_fldstg_mod.F90 +++ b/CaMa/src/cmf_calc_fldstg_mod.F90 @@ -18,212 +18,212 @@ MODULE CMF_CALC_FLDSTG_MOD ! -- CMF_OPT_FLDSTG_ES !! optimized code for vector processor (such as Earth Simulator), activated using LSTG_ES=.TRUE. option). ! -- !#################################################################### -SUBROUTINE CMF_CALC_FLDSTG_DEF -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: NLFP -USE YOS_CMF_MAP, ONLY: NSEQALL, D2GRAREA, D2RIVLEN, D2RIVWTH, D2RIVELV -USE YOS_CMF_MAP, ONLY: D2RIVSTOMAX, D2FLDSTOMAX, D2FLDGRD, DFRCINC -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV -USE YOS_CMF_DIAG, ONLY: P0GLBSTOPRE2, P0GLBSTONEW2, P0GLBRIVSTO, P0GLBFLDSTO, P0GLBFLDARE -IMPLICIT NONE - -!*** LOCAL -INTEGER(KIND=JPIM),SAVE :: ISEQ, I -REAL(KIND=JPRD),SAVE :: DSTOALL, DSTONOW, DSTOPRE, DWTHNOW, DWTHPRE, DDPHPRE, DWTHINC + SUBROUTINE CMF_CALC_FLDSTG_DEF + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: NLFP + USE YOS_CMF_MAP, only: NSEQALL, D2GRAREA, D2RIVLEN, D2RIVWTH, D2RIVELV + USE YOS_CMF_MAP, only: D2RIVSTOMAX, D2FLDSTOMAX, D2FLDGRD, DFRCINC + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO + USE YOS_CMF_DIAG, only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV + USE YOS_CMF_DIAG, only: P0GLBSTOPRE2, P0GLBSTONEW2, P0GLBRIVSTO, P0GLBFLDSTO, P0GLBFLDARE + IMPLICIT NONE + + !*** LOCAL + integer(KIND=JPIM),SAVE :: ISEQ, I + real(KIND=JPRD),SAVE :: DSTOALL, DSTONOW, DSTOPRE, DWTHNOW, DWTHPRE, DDPHPRE, DWTHINC !$OMP THREADPRIVATE (I,DSTOALL, DSTONOW, DSTOPRE, DWTHNOW, DWTHPRE, DDPHPRE, DWTHINC) -!================================================ -P0GLBSTOPRE2=0._JPRD -P0GLBSTONEW2=0._JPRD -P0GLBRIVSTO =0._JPRD -P0GLBFLDSTO =0._JPRD -P0GLBFLDARE =0._JPRD + !================================================ + P0GLBSTOPRE2=0._JPRD + P0GLBSTONEW2=0._JPRD + P0GLBRIVSTO =0._JPRD + P0GLBFLDSTO =0._JPRD + P0GLBFLDARE =0._JPRD -! Estimate water depth and flood extent from water storage -! Solution for Equations (1) and (2) in [Yamazaki et al. 2011 WRR]. + ! Estimate water depth and flood extent from water storage + ! Solution for Equations (1) and (2) in [Yamazaki et al. 2011 WRR]. !$OMP PARALLEL DO REDUCTION(+:P0GLBSTOPRE2,P0GLBSTONEW2,P0GLBRIVSTO,P0GLBFLDSTO,P0GLBFLDARE) -DO ISEQ=1, NSEQALL -! - DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - - IF( DSTOALL > D2RIVSTOMAX(ISEQ,1) )THEN - I=1 - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DWTHPRE = D2RIVWTH(ISEQ,1) - DDPHPRE = 0._JPRB - DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC - DO WHILE( DSTOALL > D2FLDSTOMAX(ISEQ,1,I) .AND. I<=NLFP) - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) - DWTHPRE = DWTHPRE + DWTHINC - DDPHPRE = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHINC - I=I+1 - IF( I>NLFP ) EXIT - END DO - IF( I>NLFP )THEN - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = 0._JPRB - D2FLDDPH(ISEQ,1) = DDPHPRE + DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) - ELSE - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = -DWTHPRE + & -& ( DWTHPRE**2. + 2._JPRB * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 - D2FLDDPH(ISEQ,1) = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHNOW - ENDIF - P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) - P2RIVSTO(ISEQ,1) = MIN(P2RIVSTO(ISEQ,1),DSTOALL) - - D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) -! - P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) - D2FLDFRC(ISEQ,1) = (-D2RIVWTH(ISEQ,1) + DWTHPRE + DWTHNOW ) * (DWTHINC*NLFP)**(-1.) !! bugfix 191113, (10._JPRB -> NLFP) - D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB) - D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB) - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) - ELSE - P2RIVSTO(ISEQ,1) = DSTOALL - D2RIVDPH(ISEQ,1) = DSTOALL * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) - D2RIVDPH(ISEQ,1) = MAX( D2RIVDPH(ISEQ,1), 0._JPRB ) - P2FLDSTO(ISEQ,1) = 0._JPRD - D2FLDDPH(ISEQ,1) = 0._JPRB - D2FLDFRC(ISEQ,1) = 0._JPRB - D2FLDARE(ISEQ,1) = 0._JPRB - ENDIF - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) - - P0GLBSTOPRE2 = P0GLBSTOPRE2 + DSTOALL - P0GLBSTONEW2 = P0GLBSTONEW2 + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - P0GLBRIVSTO = P0GLBRIVSTO + P2RIVSTO(ISEQ,1) - P0GLBFLDSTO = P0GLBFLDSTO + P2FLDSTO(ISEQ,1) - P0GLBFLDARE = P0GLBFLDARE + D2FLDARE(ISEQ,1) - -END DO + DO ISEQ=1, NSEQALL + ! + DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + + IF( DSTOALL > D2RIVSTOMAX(ISEQ,1) )THEN + I=1 + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DWTHPRE = D2RIVWTH(ISEQ,1) + DDPHPRE = 0._JPRB + DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC + DO WHILE( DSTOALL > D2FLDSTOMAX(ISEQ,1,I) .and. I<=NLFP) + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DWTHPRE = DWTHPRE + DWTHINC + DDPHPRE = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHINC + I=I+1 + IF( I>NLFP ) EXIT + ENDDO + IF( I>NLFP )THEN + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = 0._JPRB + D2FLDDPH(ISEQ,1) = DDPHPRE + DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) + ELSE + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = -DWTHPRE + & + & ( DWTHPRE**2. + 2._JPRB * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 + D2FLDDPH(ISEQ,1) = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHNOW + ENDIF + P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) + P2RIVSTO(ISEQ,1) = MIN(P2RIVSTO(ISEQ,1),DSTOALL) + + D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + ! + P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) + D2FLDFRC(ISEQ,1) = (-D2RIVWTH(ISEQ,1) + DWTHPRE + DWTHNOW ) * (DWTHINC*NLFP)**(-1.) !! bugfix 191113, (10._JPRB -> NLFP) + D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB) + D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB) + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + ELSE + P2RIVSTO(ISEQ,1) = DSTOALL + D2RIVDPH(ISEQ,1) = DSTOALL * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + D2RIVDPH(ISEQ,1) = MAX( D2RIVDPH(ISEQ,1), 0._JPRB ) + P2FLDSTO(ISEQ,1) = 0._JPRD + D2FLDDPH(ISEQ,1) = 0._JPRB + D2FLDFRC(ISEQ,1) = 0._JPRB + D2FLDARE(ISEQ,1) = 0._JPRB + ENDIF + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + + P0GLBSTOPRE2 = P0GLBSTOPRE2 + DSTOALL + P0GLBSTONEW2 = P0GLBSTONEW2 + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P0GLBRIVSTO = P0GLBRIVSTO + P2RIVSTO(ISEQ,1) + P0GLBFLDSTO = P0GLBFLDSTO + P2FLDSTO(ISEQ,1) + P0GLBFLDARE = P0GLBFLDARE + D2FLDARE(ISEQ,1) + + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CMF_CALC_FLDSTG_DEF + END SUBROUTINE CMF_CALC_FLDSTG_DEF !#################################################################### ! ! ! ! !#################################################################### -SUBROUTINE CMF_OPT_FLDSTG_ES -! ========== -! Optional code for Earth Simulator (Vector Processor) -! Specify option: LSTG_ES=.TRUE. -! Faster computation on vector prosessor by avoiding IF-THEN function. (note this code will be slow on Scaler Processor) -! ========== -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: NLFP -USE YOS_CMF_MAP, ONLY: NSEQALL, D2GRAREA, D2RIVLEN, D2RIVWTH, D2RIVELV, D2RIVHGT -USE YOS_CMF_MAP, ONLY: D2RIVSTOMAX, D2FLDSTOMAX, D2FLDGRD, DFRCINC -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV -USE YOS_CMF_DIAG, ONLY: P0GLBSTOPRE2, P0GLBSTONEW2, P0GLBRIVSTO, P0GLBFLDSTO, P0GLBFLDARE -IMPLICIT NONE - -!*** LOCAL -REAL(KIND=JPRD) :: D2STODWN(NSEQALL,1) -REAL(KIND=JPRD) :: D2WTHPRE(NSEQALL,1), D2WTHINC(NSEQALL,1) - -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ, I -REAL(KIND=JPRD),SAVE :: DSTOALL, DSTONOW, DWTHNOW + SUBROUTINE CMF_OPT_FLDSTG_ES + ! ========== + ! Optional code for Earth Simulator (Vector Processor) + ! Specify option: LSTG_ES=.TRUE. + ! Faster computation on vector prosessor by avoiding IF-THEN function. (note this code will be slow on Scaler Processor) + ! ========== + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: NLFP + USE YOS_CMF_MAP, only: NSEQALL, D2GRAREA, D2RIVLEN, D2RIVWTH, D2RIVELV, D2RIVHGT + USE YOS_CMF_MAP, only: D2RIVSTOMAX, D2FLDSTOMAX, D2FLDGRD, DFRCINC + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO + USE YOS_CMF_DIAG, only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV + USE YOS_CMF_DIAG, only: P0GLBSTOPRE2, P0GLBSTONEW2, P0GLBRIVSTO, P0GLBFLDSTO, P0GLBFLDARE + IMPLICIT NONE + + !*** LOCAL + real(KIND=JPRD) :: D2STODWN(NSEQALL,1) + real(KIND=JPRD) :: D2WTHPRE(NSEQALL,1), D2WTHINC(NSEQALL,1) + + ! SAVE for OpenMP + integer(KIND=JPIM),SAVE :: ISEQ, I + real(KIND=JPRD),SAVE :: DSTOALL, DSTONOW, DWTHNOW !$OMP THREADPRIVATE (DSTOALL, DSTONOW, DWTHNOW) -!================================================ -P0GLBRIVSTO=0._JPRD -P0GLBFLDSTO=0._JPRD -P0GLBFLDARE=0._JPRD -P0GLBSTOPRE2=0._JPRD -P0GLBSTONEW2=0._JPRD + !================================================ + P0GLBRIVSTO=0._JPRD + P0GLBFLDSTO=0._JPRD + P0GLBFLDARE=0._JPRD + P0GLBSTOPRE2=0._JPRD + P0GLBSTONEW2=0._JPRD ! [1] Assume all waters in river channel !$OMP PARALLEL DO REDUCTION(+:P0GLBSTOPRE2) -DO ISEQ=1, NSEQALL - DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - - P2RIVSTO(ISEQ,1) = DSTOALL - D2RIVDPH(ISEQ,1) = DSTOALL * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) - D2RIVDPH(ISEQ,1) = MAX( D2RIVDPH(ISEQ,1), 0._JPRB ) - P2FLDSTO(ISEQ,1) = 0._JPRD - D2FLDDPH(ISEQ,1) = 0._JPRB - D2FLDFRC(ISEQ,1) = 0._JPRB - D2FLDARE(ISEQ,1) = 0._JPRB - - D2STODWN(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) - D2WTHPRE(ISEQ,1) = D2RIVWTH(ISEQ,1) - D2WTHINC(ISEQ,1) = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC - - P0GLBSTOPRE2 = P0GLBSTOPRE2 + DSTOALL -END DO + DO ISEQ=1, NSEQALL + DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + + P2RIVSTO(ISEQ,1) = DSTOALL + D2RIVDPH(ISEQ,1) = DSTOALL * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + D2RIVDPH(ISEQ,1) = MAX( D2RIVDPH(ISEQ,1), 0._JPRB ) + P2FLDSTO(ISEQ,1) = 0._JPRD + D2FLDDPH(ISEQ,1) = 0._JPRB + D2FLDFRC(ISEQ,1) = 0._JPRB + D2FLDARE(ISEQ,1) = 0._JPRB + + D2STODWN(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2WTHPRE(ISEQ,1) = D2RIVWTH(ISEQ,1) + D2WTHINC(ISEQ,1) = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC + + P0GLBSTOPRE2 = P0GLBSTOPRE2 + DSTOALL + ENDDO !$OMP END PARALLEL DO -! [2] Check floodplain level from I=1 to NLFP. Make I-NLFP loop outside for parallel computing (SIMD/Vector) -DO I=1, NLFP + ! [2] Check floodplain level from I=1 to NLFP. Make I-NLFP loop outside for parallel computing (SIMD/Vector) + DO I=1, NLFP !$OMP PARALLEL DO - DO ISEQ=1, NSEQALL - DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - - DSTONOW = DSTOALL - D2STODWN(ISEQ,1) - DSTONOW = MAX( DSTONOW, 0._JPRD ) - DWTHNOW = -D2WTHPRE(ISEQ,1) + & -& ( D2WTHPRE(ISEQ,1)**2._JPRB + 2._JPRB * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 - DWTHNOW = MIN( DWTHNOW, D2WTHINC(ISEQ,1) ) - DWTHNOW = MAX( DWTHNOW, 0.D0 ) !! modify v4.04 - - D2FLDDPH(ISEQ,1) = D2FLDDPH(ISEQ,1) + D2FLDGRD(ISEQ,1,I) * DWTHNOW - D2FLDFRC(ISEQ,1) = D2FLDFRC(ISEQ,1) + DWTHNOW/D2WTHINC(ISEQ,1) * NLFP**(-1.) - - !! Update downside floodplain step storage/depth/width - D2STODWN(ISEQ,1) = D2FLDSTOMAX(ISEQ,1,I) - D2WTHPRE(ISEQ,1) = D2WTHPRE(ISEQ,1) + D2WTHINC(ISEQ,1) - END DO - !$OMP END PARALLEL DO -END DO + DO ISEQ=1, NSEQALL + DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + + DSTONOW = DSTOALL - D2STODWN(ISEQ,1) + DSTONOW = MAX( DSTONOW, 0._JPRD ) + DWTHNOW = -D2WTHPRE(ISEQ,1) + & + & ( D2WTHPRE(ISEQ,1)**2._JPRB + 2._JPRB * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 + DWTHNOW = MIN( DWTHNOW, D2WTHINC(ISEQ,1) ) + DWTHNOW = MAX( DWTHNOW, 0.D0 ) !! modify v4.04 + + D2FLDDPH(ISEQ,1) = D2FLDDPH(ISEQ,1) + D2FLDGRD(ISEQ,1,I) * DWTHNOW + D2FLDFRC(ISEQ,1) = D2FLDFRC(ISEQ,1) + DWTHNOW/D2WTHINC(ISEQ,1) * NLFP**(-1.) + + !! Update downside floodplain step storage/depth/width + D2STODWN(ISEQ,1) = D2FLDSTOMAX(ISEQ,1,I) + D2WTHPRE(ISEQ,1) = D2WTHPRE(ISEQ,1) + D2WTHINC(ISEQ,1) + ENDDO +!$OMP END PARALLEL DO + ENDDO !! [3] flood extent saturated case !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - DSTONOW = DSTOALL - D2STODWN(ISEQ,1) - DSTONOW = MAX( DSTONOW, 0._JPRD ) - D2FLDDPH(ISEQ,1) = D2FLDDPH(ISEQ,1) + DSTONOW * D2WTHPRE(ISEQ,1)**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) -END DO + DO ISEQ=1, NSEQALL + DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + DSTONOW = DSTOALL - D2STODWN(ISEQ,1) + DSTONOW = MAX( DSTONOW, 0._JPRD ) + D2FLDDPH(ISEQ,1) = D2FLDDPH(ISEQ,1) + DSTONOW * D2WTHPRE(ISEQ,1)**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) + ENDDO !$OMP END PARALLEL DO !! [4] Floodplain stage diagnose !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL -! IF( D2FLDDPH(ISEQ,1)>0 )THEN !! bugfix v4.04 - IF( D2FLDDPH(ISEQ,1)>1.D-5 )THEN !! bugfix v4.04, to avoid false positive FLDDPH due to rounding error. - DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - - D2RIVDPH(ISEQ,1) = D2RIVHGT(ISEQ,1) + D2FLDDPH(ISEQ,1) - P2RIVSTO(ISEQ,1) = D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) - P2RIVSTO(ISEQ,1) = MIN( P2RIVSTO(ISEQ,1), DSTOALL ) !! modify v4.04 -! - P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) - - D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB) - D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB) - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) - ENDIF -END DO + DO ISEQ=1, NSEQALL + ! IF( D2FLDDPH(ISEQ,1)>0 )THEN !! bugfix v4.04 + IF( D2FLDDPH(ISEQ,1)>1.D-5 )THEN !! bugfix v4.04, to avoid false positive FLDDPH due to rounding error. + DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + + D2RIVDPH(ISEQ,1) = D2RIVHGT(ISEQ,1) + D2FLDDPH(ISEQ,1) + P2RIVSTO(ISEQ,1) = D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) + P2RIVSTO(ISEQ,1) = MIN( P2RIVSTO(ISEQ,1), DSTOALL ) !! modify v4.04 + ! + P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) + + D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB) + D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB) + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + ENDIF + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO REDUCTION(+:P0GLBSTONEW2,P0GLBRIVSTO,P0GLBFLDSTO,P0GLBFLDARE) -DO ISEQ=1, NSEQALL - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) - P0GLBSTONEW2 = P0GLBSTONEW2+ P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - P0GLBRIVSTO = P0GLBRIVSTO + P2RIVSTO(ISEQ,1) - P0GLBFLDSTO = P0GLBFLDSTO + P2FLDSTO(ISEQ,1) - P0GLBFLDARE = P0GLBFLDARE + D2FLDARE(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + P0GLBSTONEW2 = P0GLBSTONEW2+ P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P0GLBRIVSTO = P0GLBRIVSTO + P2RIVSTO(ISEQ,1) + P0GLBFLDSTO = P0GLBFLDSTO + P2FLDSTO(ISEQ,1) + P0GLBFLDARE = P0GLBFLDARE + D2FLDARE(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CMF_OPT_FLDSTG_ES + END SUBROUTINE CMF_OPT_FLDSTG_ES !#################################################################### END MODULE CMF_CALC_FLDSTG_MOD diff --git a/CaMa/src/cmf_calc_outflw_mod.F90 b/CaMa/src/cmf_calc_outflw_mod.F90 index 064978ae..c2ad8013 100755 --- a/CaMa/src/cmf_calc_outflw_mod.F90 +++ b/CaMa/src/cmf_calc_outflw_mod.F90 @@ -12,14 +12,14 @@ MODULE CMF_CALC_OUTFLW_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: DT, PDSTMTH, PMANFLD, PGRV, LFLDOUT, LSLOPEMOUTH -USE YOS_CMF_MAP, ONLY: I1NEXT, NSEQALL, NSEQRIV, NSEQMAX -USE YOS_CMF_MAP, ONLY: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH, D2RIVHGT -USE YOS_CMF_MAP, ONLY: D2RIVLEN, D2RIVMAN, D2DWNELV, D2ELEVSLOPE -USE YOS_CMF_PROG, ONLY: P2RIVSTO, D2RIVOUT, P2FLDSTO, D2FLDOUT -USE YOS_CMF_PROG, ONLY: D2RIVOUT_PRE, D2RIVDPH_PRE, D2FLDOUT_PRE, D2FLDSTO_PRE -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2RIVVEL, D2RIVINF, D2FLDDPH, D2FLDINF, D2SFCELV + USE PARKIND1, ONLY: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, ONLY: DT, PDSTMTH, PMANFLD, PGRV, LFLDOUT, LSLOPEMOUTH + USE YOS_CMF_MAP, ONLY: I1NEXT, NSEQALL, NSEQRIV, NSEQMAX + USE YOS_CMF_MAP, ONLY: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH, D2RIVHGT + USE YOS_CMF_MAP, ONLY: D2RIVLEN, D2RIVMAN, D2DWNELV, D2ELEVSLOPE + USE YOS_CMF_PROG, ONLY: P2RIVSTO, D2RIVOUT, P2FLDSTO, D2FLDOUT + USE YOS_CMF_PROG, ONLY: D2RIVOUT_PRE, D2RIVDPH_PRE, D2FLDOUT_PRE, D2FLDSTO_PRE + USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2RIVVEL, D2RIVINF, D2FLDDPH, D2FLDINF, D2SFCELV ! CONTAINS !#################################################################### @@ -27,249 +27,249 @@ MODULE CMF_CALC_OUTFLW_MOD ! -- CMF_CALC_INFLOW ! -- !#################################################################### -SUBROUTINE CMF_CALC_OUTFLW -IMPLICIT NONE -!*** Local -REAL(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elevation (t-1) [m] -REAL(KIND=JPRB) :: D2FLDDPH_PRE(NSEQMAX,1) !! floodplain depth (t-1) [m] -! save for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ -REAL(KIND=JPRB),SAVE :: DSLOPE, DOUT_PRE, DFLW, DFLW_PRE, DFLW_IMP, DAREA -REAL(KIND=JPRB),SAVE :: DSLOPE_F, DOUT_PRE_F, DFLW_F, DFLW_PRE_F, DFLW_IMP_F, DARE_F, DARE_PRE_F, DARE_IMP_F -REAL(KIND=JPRB),SAVE :: DSFCMAX, DSFCMAX_PRE + SUBROUTINE CMF_CALC_OUTFLW + IMPLICIT NONE + !*** Local + REAL(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elevation (t-1) [m] + REAL(KIND=JPRB) :: D2FLDDPH_PRE(NSEQMAX,1) !! floodplain depth (t-1) [m] + ! save for OpenMP + INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ + REAL(KIND=JPRB),SAVE :: DSLOPE, DOUT_PRE, DFLW, DFLW_PRE, DFLW_IMP, DAREA + REAL(KIND=JPRB),SAVE :: DSLOPE_F, DOUT_PRE_F, DFLW_F, DFLW_PRE_F, DFLW_IMP_F, DARE_F, DARE_PRE_F, DARE_IMP_F + REAL(KIND=JPRB),SAVE :: DSFCMAX, DSFCMAX_PRE !$OMP THREADPRIVATE (JSEQ, DSLOPE, DOUT_PRE, DFLW, DFLW_PRE, DFLW_IMP, DAREA ) !$OMP THREADPRIVATE ( DSLOPE_F, DOUT_PRE_F, DFLW_F, DFLW_PRE_F, DFLW_IMP_F, DARE_F, DARE_PRE_F, DARE_IMP_F ) !$OMP THREADPRIVATE ( DSFCMAX, DSFCMAX_PRE ) !================================================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) - D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1) - D2FLDDPH_PRE(ISEQ,1) = MAX( D2RIVDPH_PRE(ISEQ,1)-D2RIVHGT(ISEQ,1), 0._JPRB ) -END DO + DO ISEQ=1, NSEQALL + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1) + D2FLDDPH_PRE(ISEQ,1) = MAX( D2RIVDPH_PRE(ISEQ,1)-D2RIVHGT(ISEQ,1), 0._JPRB ) + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO -DO ISEQ=1, NSEQRIV !! for normal cells - JSEQ=I1NEXT(ISEQ) ! next cell's pixel - - DSFCMAX =MAX( D2SFCELV(ISEQ,1), D2SFCELV(JSEQ,1) ) - DSFCMAX_PRE=MAX( D2SFCELV_PRE(ISEQ,1),D2SFCELV_PRE(JSEQ,1) ) - DSLOPE = ( D2SFCELV(ISEQ,1)-D2SFCELV(JSEQ,1) ) * D2NXTDST(ISEQ,1)**(-1.) - DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] + DO ISEQ=1, NSEQRIV !! for normal cells + JSEQ=I1NEXT(ISEQ) ! next cell's pixel + + DSFCMAX =MAX( D2SFCELV(ISEQ,1), D2SFCELV(JSEQ,1) ) + DSFCMAX_PRE=MAX( D2SFCELV_PRE(ISEQ,1),D2SFCELV_PRE(JSEQ,1) ) + DSLOPE = ( D2SFCELV(ISEQ,1)-D2SFCELV(JSEQ,1) ) * D2NXTDST(ISEQ,1)**(-1.) + DSLOPE_F = MAX( -0.005_JPRB, MIN( 0.005_JPRB,DSLOPE )) !! set MAX&MIN [instead of using weir equation for efficiency] -!=== River Flow === - DFLW = DSFCMAX - D2RIVELV(ISEQ,1) !! flow cross-section depth - DAREA = D2RIVWTH(ISEQ,1) * DFLW !! flow cross-section area + !=== River Flow === + DFLW = DSFCMAX - D2RIVELV(ISEQ,1) !! flow cross-section depth + DAREA = D2RIVWTH(ISEQ,1) * DFLW !! flow cross-section area - DFLW_PRE=DSFCMAX_PRE - D2RIVELV(ISEQ,1) - DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5 ,1.E-6_JPRB ) !! semi implicit flow depth + DFLW_PRE=DSFCMAX_PRE - D2RIVELV(ISEQ,1) + DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5 ,1.E-6_JPRB ) !! semi implicit flow depth - IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN - DOUT_PRE= D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) !! outflow (t-1) [m2/s] (unit width) - D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2.*abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1.) - ELSE - D2RIVOUT(ISEQ,1) = 0._JPRB - D2RIVVEL(ISEQ,1) = 0._JPRB - ENDIF + IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN + DOUT_PRE= D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) !! outflow (t-1) [m2/s] (unit width) + D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2.*abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1.) + ELSE + D2RIVOUT(ISEQ,1) = 0._JPRB + D2RIVVEL(ISEQ,1) = 0._JPRB + ENDIF -!=== Floodplain Flow === - IF( LFLDOUT )THEN - DFLW_F = MAX( DSFCMAX-D2ELEVTN(ISEQ,1), 0._JPRB ) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - DFLW_PRE_F = DSFCMAX_PRE - D2ELEVTN(ISEQ,1) - DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) - - DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area - DARE_IMP_F = max( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) - - IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN - DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) - D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & - * (1. + PGRV*DT*PMANFLD**2. * abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1._JPRB) - ELSE - D2FLDOUT(ISEQ,1) = 0._JPRB - ENDIF - - IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization - ENDIF -END DO + !=== Floodplain Flow === + IF( LFLDOUT )THEN + DFLW_F = MAX( DSFCMAX-D2ELEVTN(ISEQ,1), 0._JPRB ) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + DFLW_PRE_F = DSFCMAX_PRE - D2ELEVTN(ISEQ,1) + DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) + + DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area + DARE_IMP_F = MAX( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) + + IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN + DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) + D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & + * (1. + PGRV*DT*PMANFLD**2. * abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1._JPRB) + ELSE + D2FLDOUT(ISEQ,1) = 0._JPRB + ENDIF + + IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization + ENDIF + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO !! for river mouth grids -DO ISEQ=NSEQRIV+1, NSEQALL - IF ( LSLOPEMOUTH ) THEN - ! prescribed slope - DSLOPE = D2ELEVSLOPE(ISEQ,1) - ELSE - DSLOPE = ( D2SFCELV(ISEQ,1) - D2DWNELV(ISEQ,1) ) * PDSTMTH ** (-1.) - ENDIF - DSLOPE_F = max( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] -!=== river mouth flow === + DO ISEQ=NSEQRIV+1, NSEQALL + IF ( LSLOPEMOUTH ) THEN + ! prescribed slope + DSLOPE = D2ELEVSLOPE(ISEQ,1) + ELSE + DSLOPE = ( D2SFCELV(ISEQ,1) - D2DWNELV(ISEQ,1) ) * PDSTMTH ** (-1.) + ENDIF + DSLOPE_F = MAX( -0.005_JPRB, MIN( 0.005_JPRB,DSLOPE )) !! set MAX&MIN [instead of using weir equation for efficiency] + !=== river mouth flow === - DFLW = D2RIVDPH(ISEQ,1) - DAREA = D2RIVWTH(ISEQ,1) * DFLW + DFLW = D2RIVDPH(ISEQ,1) + DAREA = D2RIVWTH(ISEQ,1) * DFLW - DFLW_PRE=D2RIVDPH_PRE(ISEQ,1) - DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5, 1.E-6_JPRB ) !! semi implicit flow depth + DFLW_PRE=D2RIVDPH_PRE(ISEQ,1) + DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5, 1.E-6_JPRB ) !! semi implicit flow depth - IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN - DOUT_PRE = D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) - D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1._JPRB) - ELSE - D2RIVOUT(ISEQ,1) = 0._JPRB - D2RIVVEL(ISEQ,1) = 0._JPRB - ENDIF + IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN + DOUT_PRE = D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) + D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1._JPRB) + ELSE + D2RIVOUT(ISEQ,1) = 0._JPRB + D2RIVVEL(ISEQ,1) = 0._JPRB + ENDIF -!=== floodplain mouth flow === - IF( LFLDOUT )THEN - DFLW_F = D2SFCELV(ISEQ,1)-D2ELEVTN(ISEQ,1) - - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - DFLW_PRE_F = D2SFCELV_PRE(ISEQ,1)-D2ELEVTN(ISEQ,1) - DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) - - DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area - DARE_IMP_F = max( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) - - IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN - DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) - D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & - * (1. + PGRV*DT*PMANFLD**2. * abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1.) - ELSE - D2FLDOUT(ISEQ,1) = 0._JPRB - ENDIF - - IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization - ENDIF -END DO + !=== floodplain mouth flow === + IF( LFLDOUT )THEN + DFLW_F = D2SFCELV(ISEQ,1)-D2ELEVTN(ISEQ,1) + + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + DFLW_PRE_F = D2SFCELV_PRE(ISEQ,1)-D2ELEVTN(ISEQ,1) + DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) + + DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area + DARE_IMP_F = MAX( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) + + IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN + DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) + D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & + * (1. + PGRV*DT*PMANFLD**2. * abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1.) + ELSE + D2FLDOUT(ISEQ,1) = 0._JPRB + ENDIF + + IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization + ENDIF + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CMF_CALC_OUTFLW + END SUBROUTINE CMF_CALC_OUTFLW !#################################################################### !+ !+ !+ !#################################################################### -SUBROUTINE CMF_CALC_INFLOW -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_MAP, ONLY: NSEQMAX -IMPLICIT NONE -REAL(KIND=JPRD) :: P2STOOUT(NSEQMAX,1) !! total outflow from a grid [m3] -REAL(KIND=JPRD) :: P2RIVINF(NSEQMAX,1) !! -REAL(KIND=JPRD) :: P2FLDINF(NSEQMAX,1) !! + SUBROUTINE CMF_CALC_INFLOW + USE PARKIND1, ONLY: JPIM, JPRB, JPRD + USE YOS_CMF_MAP, ONLY: NSEQMAX + IMPLICIT NONE + REAL(KIND=JPRD) :: P2STOOUT(NSEQMAX,1) !! total outflow from a grid [m3] + REAL(KIND=JPRD) :: P2RIVINF(NSEQMAX,1) !! + REAL(KIND=JPRD) :: P2FLDINF(NSEQMAX,1) !! -REAL(KIND=JPRB) :: D2RATE(NSEQMAX,1) !! outflow correction -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ -REAL(KIND=JPRB),SAVE :: OUT_R1, OUT_R2, OUT_F1, OUT_F2, DIUP, DIDW + REAL(KIND=JPRB) :: D2RATE(NSEQMAX,1) !! outflow correction + ! SAVE for OpenMP + INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ + REAL(KIND=JPRB),SAVE :: OUT_R1, OUT_R2, OUT_F1, OUT_F2, DIUP, DIDW !$OMP THREADPRIVATE (JSEQ,OUT_R1, OUT_R2, OUT_F1, OUT_F2, DIUP, DIDW) !================================================ !*** 1. initialize & calculate P2STOOUT for normal cells !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - P2RIVINF(ISEQ,1) = 0._JPRD - P2FLDINF(ISEQ,1) = 0._JPRD - P2STOOUT(ISEQ,1) = 0._JPRD - D2RATE(ISEQ,1) = 1._JPRB -END DO + DO ISEQ=1, NSEQALL + P2RIVINF(ISEQ,1) = 0._JPRD + P2FLDINF(ISEQ,1) = 0._JPRD + P2STOOUT(ISEQ,1) = 0._JPRD + D2RATE(ISEQ,1) = 1._JPRB + ENDDO !$OMP END PARALLEL DO !! for normal cells --------- #ifndef NoAtom_CMF !$OMP PARALLEL DO #endif -DO ISEQ=1, NSEQRIV !! for normalcells - JSEQ=I1NEXT(ISEQ) ! next cell's pixel - OUT_R1 = max( D2RIVOUT(ISEQ,1),0._JPRB ) - OUT_R2 = max( -D2RIVOUT(ISEQ,1),0._JPRB ) - OUT_F1 = max( D2FLDOUT(ISEQ,1),0._JPRB ) - OUT_F2 = max( -D2FLDOUT(ISEQ,1),0._JPRB ) - DIUP=(OUT_R1+OUT_F1)*DT - DIDW=(OUT_R2+OUT_F2)*DT + DO ISEQ=1, NSEQRIV !! for normalcells + JSEQ=I1NEXT(ISEQ) ! next cell's pixel + OUT_R1 = MAX( D2RIVOUT(ISEQ,1),0._JPRB ) + OUT_R2 = MAX( -D2RIVOUT(ISEQ,1),0._JPRB ) + OUT_F1 = MAX( D2FLDOUT(ISEQ,1),0._JPRB ) + OUT_F2 = MAX( -D2FLDOUT(ISEQ,1),0._JPRB ) + DIUP=(OUT_R1+OUT_F1)*DT + DIDW=(OUT_R2+OUT_F2)*DT #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2STOOUT(ISEQ,1) = P2STOOUT(ISEQ,1) + DIUP + P2STOOUT(ISEQ,1) = P2STOOUT(ISEQ,1) + DIUP #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2STOOUT(JSEQ,1) = P2STOOUT(JSEQ,1) + DIDW -END DO + P2STOOUT(JSEQ,1) = P2STOOUT(JSEQ,1) + DIDW + ENDDO #ifndef NoAtom_CMF !$OMP END PARALLEL DO #endif !! for river mouth grids ------------ !$OMP PARALLEL DO -DO ISEQ=NSEQRIV+1, NSEQALL - OUT_R1 = max( D2RIVOUT(ISEQ,1), 0._JPRB ) - OUT_F1 = max( D2FLDOUT(ISEQ,1), 0._JPRB ) - P2STOOUT(ISEQ,1) = P2STOOUT(ISEQ,1) + OUT_R1*DT + OUT_F1*DT -END DO + DO ISEQ=NSEQRIV+1, NSEQALL + OUT_R1 = MAX( D2RIVOUT(ISEQ,1), 0._JPRB ) + OUT_F1 = MAX( D2FLDOUT(ISEQ,1), 0._JPRB ) + P2STOOUT(ISEQ,1) = P2STOOUT(ISEQ,1) + OUT_R1*DT + OUT_F1*DT + ENDDO !$OMP END PARALLEL DO !============================ !*** 2. modify outflow !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - IF ( P2STOOUT(ISEQ,1) > 1.E-8 ) THEN - D2RATE(ISEQ,1) = min( (P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1)) * P2STOOUT(ISEQ,1)**(-1.), 1._JPRD ) - ENDIF -END DO + DO ISEQ=1, NSEQALL + IF ( P2STOOUT(ISEQ,1) > 1.E-8 ) THEN + D2RATE(ISEQ,1) = MIN( (P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1)) * P2STOOUT(ISEQ,1)**(-1.), 1._JPRD ) + ENDIF + ENDDO !$OMP END PARALLEL DO !! normal pixels------ #ifndef NoAtom_CMF !$OMP PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -DO ISEQ=1, NSEQRIV ! for normal pixels - JSEQ=I1NEXT(ISEQ) - IF( D2RIVOUT(ISEQ,1) >= 0._JPRB )THEN - D2RIVOUT(ISEQ,1) = D2RIVOUT(ISEQ,1)*D2RATE(ISEQ,1) - D2FLDOUT(ISEQ,1) = D2FLDOUT(ISEQ,1)*D2RATE(ISEQ,1) - ELSE - D2RIVOUT(ISEQ,1) = D2RIVOUT(ISEQ,1)*D2RATE(JSEQ,1) - D2FLDOUT(ISEQ,1) = D2FLDOUT(ISEQ,1)*D2RATE(JSEQ,1) - ENDIF + DO ISEQ=1, NSEQRIV ! for normal pixels + JSEQ=I1NEXT(ISEQ) + IF( D2RIVOUT(ISEQ,1) >= 0._JPRB )THEN + D2RIVOUT(ISEQ,1) = D2RIVOUT(ISEQ,1)*D2RATE(ISEQ,1) + D2FLDOUT(ISEQ,1) = D2FLDOUT(ISEQ,1)*D2RATE(ISEQ,1) + ELSE + D2RIVOUT(ISEQ,1) = D2RIVOUT(ISEQ,1)*D2RATE(JSEQ,1) + D2FLDOUT(ISEQ,1) = D2FLDOUT(ISEQ,1)*D2RATE(JSEQ,1) + ENDIF #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2RIVINF(JSEQ,1) = P2RIVINF(JSEQ,1) + D2RIVOUT(ISEQ,1) !! total inflow to a grid (from upstream) + P2RIVINF(JSEQ,1) = P2RIVINF(JSEQ,1) + D2RIVOUT(ISEQ,1) !! total inflow to a grid (from upstream) #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2FLDINF(JSEQ,1) = P2FLDINF(JSEQ,1) + D2FLDOUT(ISEQ,1) -END DO + P2FLDINF(JSEQ,1) = P2FLDINF(JSEQ,1) + D2FLDOUT(ISEQ,1) + ENDDO #ifndef NoAtom_CMF !$OMP END PARALLEL DO #endif !! river mouth----------------- !$OMP PARALLEL DO -DO ISEQ=NSEQRIV+1, NSEQALL - D2RIVOUT(ISEQ,1) = D2RIVOUT(ISEQ,1)*D2RATE(ISEQ,1) - D2FLDOUT(ISEQ,1) = D2FLDOUT(ISEQ,1)*D2RATE(ISEQ,1) -END DO + DO ISEQ=NSEQRIV+1, NSEQALL + D2RIVOUT(ISEQ,1) = D2RIVOUT(ISEQ,1)*D2RATE(ISEQ,1) + D2FLDOUT(ISEQ,1) = D2FLDOUT(ISEQ,1)*D2RATE(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -D2RIVINF(:,:)=P2RIVINF(:,:) !! needed for SinglePrecisionMode -D2FLDINF(:,:)=P2FLDINF(:,:) + D2RIVINF(:,:)=P2RIVINF(:,:) !! needed for SinglePrecisionMode + D2FLDINF(:,:)=P2FLDINF(:,:) -END SUBROUTINE CMF_CALC_INFLOW + END SUBROUTINE CMF_CALC_INFLOW !#################################################################### END MODULE CMF_CALC_OUTFLW_MOD diff --git a/CaMa/src/cmf_calc_pthout_mod.F90 b/CaMa/src/cmf_calc_pthout_mod.F90 index 75513545..a85e9029 100755 --- a/CaMa/src/cmf_calc_pthout_mod.F90 +++ b/CaMa/src/cmf_calc_pthout_mod.F90 @@ -17,148 +17,148 @@ MODULE CMF_CALC_PTHOUT_MOD ! -- CMF_CALC_PTHOUT ! -- !#################################################################### -SUBROUTINE CMF_CALC_PTHOUT -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: DT, PGRV, DMIS -USE YOS_CMF_MAP, ONLY: NSEQALL, NSEQMAX, NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN, PTH_DST, & - & PTH_ELV, PTH_WTH, PTH_MAN, I2MASK -USE YOS_CMF_MAP, ONLY: D2RIVELV -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, D1PTHFLW, D2RIVOUT, D2FLDOUT -USE YOS_CMF_PROG, ONLY: D1PTHFLW_PRE, D2RIVDPH_PRE -USE YOS_CMF_DIAG, ONLY: D2PTHOUT, D2PTHINF, D2RIVINF, D2FLDINF, D2SFCELV -IMPLICIT NONE -!*** Local -REAL(KIND=JPRD) :: P2PTHOUT(NSEQMAX,1) !! for water conservation -REAL(KIND=JPRD) :: P2PTHINF(NSEQMAX,1) !! for water conservation - -REAL(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elev (t-1) [m] (for stable calculation) -REAL(KIND=JPRB) :: D2RATE(NSEQMAX,1) !! outflow correction - -! Save for OpenMP -INTEGER(KIND=JPIM),SAVE :: IPTH, ILEV, ISEQ, ISEQP, JSEQP -REAL(KIND=JPRB),SAVE :: DSLOPE, DFLW, DOUT_PRE, DFLW_PRE, DFLW_IMP, DSTO_TMP + SUBROUTINE CMF_CALC_PTHOUT + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: DT, PGRV, DMIS + USE YOS_CMF_MAP, only: NSEQALL, NSEQMAX, NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN, PTH_DST, & + & PTH_ELV, PTH_WTH, PTH_MAN, I2MASK + USE YOS_CMF_MAP, only: D2RIVELV + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, D1PTHFLW, D2RIVOUT, D2FLDOUT + USE YOS_CMF_PROG, only: D1PTHFLW_PRE, D2RIVDPH_PRE + USE YOS_CMF_DIAG, only: D2PTHOUT, D2PTHINF, D2RIVINF, D2FLDINF, D2SFCELV + IMPLICIT NONE + !*** Local + real(KIND=JPRD) :: P2PTHOUT(NSEQMAX,1) !! for water conservation + real(KIND=JPRD) :: P2PTHINF(NSEQMAX,1) !! for water conservation + + real(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elev (t-1) [m] (for stable calculation) + real(KIND=JPRB) :: D2RATE(NSEQMAX,1) !! outflow correction + + ! Save for OpenMP + integer(KIND=JPIM),SAVE :: IPTH, ILEV, ISEQ, ISEQP, JSEQP + real(KIND=JPRB),SAVE :: DSLOPE, DFLW, DOUT_PRE, DFLW_PRE, DFLW_IMP, DSTO_TMP !$OMP THREADPRIVATE (DSLOPE, DFLW, DOUT_PRE, DFLW_PRE, DFLW_IMP, DSTO_TMP, ILEV, ISEQP, JSEQP) !================================================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1)+D2RIVDPH_PRE(ISEQ,1) - P2PTHOUT(ISEQ,1) = 0._JPRD - P2PTHINF(ISEQ,1) = 0._JPRD - D2RATE(ISEQ,1) =-999._JPRB -END DO + DO ISEQ=1, NSEQALL + D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1)+D2RIVDPH_PRE(ISEQ,1) + P2PTHOUT(ISEQ,1) = 0._JPRD + P2PTHINF(ISEQ,1) = 0._JPRD + D2RATE(ISEQ,1) =-999._JPRB + ENDDO !$OMP END PARALLEL DO -D1PTHFLW(:,:) = DMIS + D1PTHFLW(:,:) = DMIS !$OMP PARALLEL DO -DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - !! Avoid calculation outside of domain - IF (ISEQP<=0 .OR. JSEQP<=0 ) CYCLE - IF (I2MASK(ISEQP,1)>0 .OR. I2MASK(JSEQP,1)>0 ) CYCLE !! I2MASK is for 1: kinemacit 2: dam no bifurcation - - DSLOPE = (D2SFCELV(ISEQP,1)-D2SFCELV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) - DSLOPE = max(-0.005_JPRB,min(0.005_JPRB,DSLOPE)) !! v390 stabilization - - DO ILEV=1, NPTHLEV - - DFLW = MAX(D2SFCELV(ISEQP,1),D2SFCELV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) - DFLW = MAX(DFLW,0._JPRB) - - DFLW_PRE = MAX(D2SFCELV_PRE(ISEQP,1),D2SFCELV_PRE(JSEQP,1)) - PTH_ELV(IPTH,ILEV) - DFLW_PRE = MAX(DFLW_PRE,0._JPRB) - - DFLW_IMP = (DFLW*DFLW_PRE)**0.5 !! semi implicit flow depth - IF( DFLW_IMP<=0._JPRB ) DFLW_IMP=DFLW - - IF( DFLW_IMP>1.E-5 )THEN !! local inertial equation, see [Bates et al., 2010, J.Hydrol.] - DOUT_PRE = D1PTHFLW_PRE(IPTH,ILEV) * PTH_WTH(IPTH,ILEV)**(-1.) !! outflow (t-1) [m2/s] (unit width) - D1PTHFLW(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*PTH_MAN(ILEV)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - ELSE - D1PTHFLW(IPTH,ILEV) = 0._JPRB - ENDIF - END DO -END DO + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + !! Avoid calculation outside of domain + IF (ISEQP<=0 .or. JSEQP<=0 ) CYCLE + IF (I2MASK(ISEQP,1)>0 .or. I2MASK(JSEQP,1)>0 ) CYCLE !! I2MASK is for 1: kinemacit 2: dam no bifurcation + + DSLOPE = (D2SFCELV(ISEQP,1)-D2SFCELV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) + DSLOPE = max(-0.005_JPRB,min(0.005_JPRB,DSLOPE)) !! v390 stabilization + + DO ILEV=1, NPTHLEV + + DFLW = MAX(D2SFCELV(ISEQP,1),D2SFCELV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) + DFLW = MAX(DFLW,0._JPRB) + + DFLW_PRE = MAX(D2SFCELV_PRE(ISEQP,1),D2SFCELV_PRE(JSEQP,1)) - PTH_ELV(IPTH,ILEV) + DFLW_PRE = MAX(DFLW_PRE,0._JPRB) + + DFLW_IMP = (DFLW*DFLW_PRE)**0.5 !! semi implicit flow depth + IF( DFLW_IMP<=0._JPRB ) DFLW_IMP=DFLW + + IF( DFLW_IMP>1.E-5 )THEN !! local inertial equation, see [Bates et al., 2010, J.Hydrol.] + DOUT_PRE = D1PTHFLW_PRE(IPTH,ILEV) * PTH_WTH(IPTH,ILEV)**(-1.) !! outflow (t-1) [m2/s] (unit width) + D1PTHFLW(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*PTH_MAN(ILEV)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + ELSE + D1PTHFLW(IPTH,ILEV) = 0._JPRB + ENDIF + ENDDO + ENDDO !$OMP END PARALLEL DO #ifndef NoAtom_CMF !$OMP PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - !! Avoid calculation outside of domain - IF (ISEQP<=0 .OR. JSEQP<=0 ) CYCLE - IF (I2MASK(ISEQP,1)>0 .OR. I2MASK(JSEQP,1)>0 ) CYCLE !! I2MASK is for 1: kinemacit 2: dam no bifurcation - - DO ILEV=1, NPTHLEV - IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN !! total outflow from each grid + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + !! Avoid calculation outside of domain + IF (ISEQP<=0 .or. JSEQP<=0 ) CYCLE + IF (I2MASK(ISEQP,1)>0 .or. I2MASK(JSEQP,1)>0 ) CYCLE !! I2MASK is for 1: kinemacit 2: dam no bifurcation + + DO ILEV=1, NPTHLEV + IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN !! total outflow from each grid #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHOUT(ISEQP,1) = P2PTHOUT(ISEQP,1) + D1PTHFLW(IPTH,ILEV) - ELSE + P2PTHOUT(ISEQP,1) = P2PTHOUT(ISEQP,1) + D1PTHFLW(IPTH,ILEV) + ELSE #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHOUT(JSEQP,1) = P2PTHOUT(JSEQP,1) - D1PTHFLW(IPTH,ILEV) - ENDIF - END DO -END DO + P2PTHOUT(JSEQP,1) = P2PTHOUT(JSEQP,1) - D1PTHFLW(IPTH,ILEV) + ENDIF + ENDDO + ENDDO #ifndef NoAtom_CMF !$OMP END PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif !$OMP PARALLEL DO !! calculate total outflow from a grid -DO ISEQ=1, NSEQALL - IF( P2PTHOUT(ISEQ,1) > 1.E-10 )THEN - DSTO_TMP = ( P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) ) & - - D2RIVOUT(ISEQ,1)*DT + D2RIVINF(ISEQ,1)*DT - D2FLDOUT(ISEQ,1)*DT + D2FLDINF(ISEQ,1)*DT - D2RATE(ISEQ,1) = MIN( DSTO_TMP * (P2PTHOUT(ISEQ,1)*DT)**(-1.), 1._JPRD ) - ELSE - D2RATE(ISEQ,1) = 1._JPRB - ENDIF - P2PTHOUT(ISEQ,1) = P2PTHOUT(ISEQ,1) * D2RATE(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL + IF( P2PTHOUT(ISEQ,1) > 1.E-10 )THEN + DSTO_TMP = ( P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) ) & + - D2RIVOUT(ISEQ,1)*DT + D2RIVINF(ISEQ,1)*DT - D2FLDOUT(ISEQ,1)*DT + D2FLDINF(ISEQ,1)*DT + D2RATE(ISEQ,1) = MIN( DSTO_TMP * (P2PTHOUT(ISEQ,1)*DT)**(-1.), 1._JPRD ) + ELSE + D2RATE(ISEQ,1) = 1._JPRB + ENDIF + P2PTHOUT(ISEQ,1) = P2PTHOUT(ISEQ,1) * D2RATE(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -D2PTHOUT(:,:)=P2PTHOUT(:,:) + D2PTHOUT(:,:)=P2PTHOUT(:,:) #ifndef NoAtom_CMF !$OMP PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - !! Avoid calculation outside of domain - IF (ISEQP<=0 .OR. JSEQP<=0 ) CYCLE - IF (I2MASK(ISEQP,1)>0 .OR. I2MASK(JSEQP,1)>0 ) CYCLE !! I2MASK is for 1: kinemacit 2: dam no bifurcation - - DO ILEV=1, NPTHLEV - IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN - D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(ISEQP,1) + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + !! Avoid calculation outside of domain + IF (ISEQP<=0 .or. JSEQP<=0 ) CYCLE + IF (I2MASK(ISEQP,1)>0 .or. I2MASK(JSEQP,1)>0 ) CYCLE !! I2MASK is for 1: kinemacit 2: dam no bifurcation + + DO ILEV=1, NPTHLEV + IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN + D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(ISEQP,1) #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHINF(JSEQP,1) = P2PTHINF(JSEQP,1) + D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) - ELSE - D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(JSEQP,1) + P2PTHINF(JSEQP,1) = P2PTHINF(JSEQP,1) + D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) + ELSE + D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(JSEQP,1) #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHINF(ISEQP,1) = P2PTHINF(ISEQP,1) - D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) - ENDIF - D1PTHFLW_PRE(IPTH,ILEV)=D1PTHFLW(IPTH,ILEV) - END DO -END DO + P2PTHINF(ISEQP,1) = P2PTHINF(ISEQP,1) - D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) + ENDIF + D1PTHFLW_PRE(IPTH,ILEV)=D1PTHFLW(IPTH,ILEV) + ENDDO + ENDDO #ifndef NoAtom_CMF !$OMP END PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -D2PTHINF(:,:)=P2PTHINF(:,:) + D2PTHINF(:,:)=P2PTHINF(:,:) -END SUBROUTINE CMF_CALC_PTHOUT + END SUBROUTINE CMF_CALC_PTHOUT !#################################################################### diff --git a/CaMa/src/cmf_calc_stonxt_mod.F90 b/CaMa/src/cmf_calc_stonxt_mod.F90 index 8b5a4c2f..a882bc33 100755 --- a/CaMa/src/cmf_calc_stonxt_mod.F90 +++ b/CaMa/src/cmf_calc_stonxt_mod.F90 @@ -7,7 +7,7 @@ MODULE CMF_CALC_STONXT_MOD ! Modified by Zhongwang Wei @ SYSU 2022.11.20: add water re-infiltration calculation ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is @@ -19,126 +19,125 @@ MODULE CMF_CALC_STONXT_MOD ! -- CMF_CALC_STONXT ! !#################################################################### -SUBROUTINE CMF_CALC_STONXT -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: LGDWDLY, DT, LWEVAP, LWINFILT -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_PROG, ONLY: D2RIVOUT, D2FLDOUT, P2RIVSTO, P2FLDSTO, D2RUNOFF -USE YOS_CMF_PROG, ONLY: P2GDWSTO, D2GDWRTN, D2ROFSUB, D2WEVAP,D2WINFILT -USE YOS_CMF_DIAG, ONLY: D2RIVINF, D2FLDINF, D2PTHOUT, D2PTHINF, D2FLDFRC, & - & D2OUTFLW, D2STORGE, D2WEVAPEX,D2WINFILTEX -USE YOS_CMF_DIAG, ONLY: P0GLBSTOPRE,P0GLBSTONXT,P0GLBSTONEW,P0GLBRIVINF,P0GLBRIVOUT -IMPLICIT NONE -! Save for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ -REAL(KIND=JPRB),SAVE :: DRIVROF, DFLDROF, DWEVAPEX,DWINFILTEX + SUBROUTINE CMF_CALC_STONXT + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: LGDWDLY, DT, LWEVAP, LWINFILT + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_PROG, only: D2RIVOUT, D2FLDOUT, P2RIVSTO, P2FLDSTO, D2RUNOFF + USE YOS_CMF_PROG, only: P2GDWSTO, D2GDWRTN, D2ROFSUB, D2WEVAP,D2WINFILT + USE YOS_CMF_DIAG, only: D2RIVINF, D2FLDINF, D2PTHOUT, D2PTHINF, D2FLDFRC, & + & D2OUTFLW, D2STORGE, D2WEVAPEX,D2WINFILTEX + USE YOS_CMF_DIAG, only: P0GLBSTOPRE,P0GLBSTONXT,P0GLBSTONEW,P0GLBRIVINF,P0GLBRIVOUT + IMPLICIT NONE + ! Save for OpenMP + integer(KIND=JPIM),SAVE :: ISEQ + real(KIND=JPRB),SAVE :: DRIVROF, DFLDROF, DWEVAPEX,DWINFILTEX !$OMP THREADPRIVATE (DRIVROF, DFLDROF, DWEVAPEX,DWINFILTEX) !================================================ -IF ( LGDWDLY ) THEN - CALL CALC_GDWDLY -ELSE + IF ( LGDWDLY ) THEN + CALL CALC_GDWDLY + ELSE ! No ground water delay - !$OMP PARALLEL DO - DO ISEQ=1,NSEQALL - D2GDWRTN(ISEQ,1) = D2ROFSUB(ISEQ,1) - P2GDWSTO(ISEQ,1) = 0._JPRD - ENDDO - !$OMP END PARALLEL DO -ENDIF +!$OMP PARALLEL DO + DO ISEQ=1,NSEQALL + D2GDWRTN(ISEQ,1) = D2ROFSUB(ISEQ,1) + P2GDWSTO(ISEQ,1) = 0._JPRD + ENDDO +!$OMP END PARALLEL DO + ENDIF !!============================== -P0GLBSTOPRE=0._JPRD -P0GLBSTONXT=0._JPRD -P0GLBSTONEW=0._JPRD -P0GLBRIVINF=0._JPRD -P0GLBRIVOUT=0._JPRD + P0GLBSTOPRE=0._JPRD + P0GLBSTONXT=0._JPRD + P0GLBSTONEW=0._JPRD + P0GLBRIVINF=0._JPRD + P0GLBRIVOUT=0._JPRD !$OMP PARALLEL DO REDUCTION(+:P0GLBSTOPRE,P0GLBRIVINF,P0GLBRIVOUT,P0GLBSTONXT,P0GLBSTONEW) -DO ISEQ=1, NSEQALL + DO ISEQ=1, NSEQALL - P0GLBSTOPRE = P0GLBSTOPRE + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - P0GLBRIVINF = P0GLBRIVINF + D2RIVINF(ISEQ,1)*DT + D2FLDINF(ISEQ,1)*DT + D2PTHINF(ISEQ,1)*DT - P0GLBRIVOUT = P0GLBRIVOUT + D2RIVOUT(ISEQ,1)*DT + D2FLDOUT(ISEQ,1)*DT + D2PTHOUT(ISEQ,1)*DT + P0GLBSTOPRE = P0GLBSTOPRE + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P0GLBRIVINF = P0GLBRIVINF + D2RIVINF(ISEQ,1)*DT + D2FLDINF(ISEQ,1)*DT + D2PTHINF(ISEQ,1)*DT + P0GLBRIVOUT = P0GLBRIVOUT + D2RIVOUT(ISEQ,1)*DT + D2FLDOUT(ISEQ,1)*DT + D2PTHOUT(ISEQ,1)*DT - P2RIVSTO(ISEQ,1) = P2RIVSTO(ISEQ,1) + D2RIVINF(ISEQ,1)*DT - D2RIVOUT(ISEQ,1)*DT - IF ( P2RIVSTO(ISEQ,1) < 0._JPRB ) THEN - P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) + P2RIVSTO(ISEQ,1) - P2RIVSTO(ISEQ,1) = 0._JPRD - ENDIF + P2RIVSTO(ISEQ,1) = P2RIVSTO(ISEQ,1) + D2RIVINF(ISEQ,1)*DT - D2RIVOUT(ISEQ,1)*DT + IF ( P2RIVSTO(ISEQ,1) < 0._JPRB ) THEN + P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) + P2RIVSTO(ISEQ,1) + P2RIVSTO(ISEQ,1) = 0._JPRD + ENDIF - P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) + D2FLDINF(ISEQ,1)*DT - D2FLDOUT(ISEQ,1)*DT & - + D2PTHINF(ISEQ,1)*DT - D2PTHOUT(ISEQ,1)*DT - IF( P2FLDSTO(ISEQ,1) < 0._JPRD )THEN - P2RIVSTO(ISEQ,1)=MAX( P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1), 0._JPRD ) - P2FLDSTO(ISEQ,1)=0._JPRD - ENDIF + P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) + D2FLDINF(ISEQ,1)*DT - D2FLDOUT(ISEQ,1)*DT & + + D2PTHINF(ISEQ,1)*DT - D2PTHOUT(ISEQ,1)*DT + IF( P2FLDSTO(ISEQ,1) < 0._JPRD )THEN + P2RIVSTO(ISEQ,1)=MAX( P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1), 0._JPRD ) + P2FLDSTO(ISEQ,1)=0._JPRD + ENDIF - P0GLBSTONXT = P0GLBSTONXT + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) - D2OUTFLW(ISEQ,1)=D2RIVOUT(ISEQ,1)+D2FLDOUT(ISEQ,1)+D2PTHOUT(ISEQ,1) + P0GLBSTONXT = P0GLBSTONXT + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + D2OUTFLW(ISEQ,1)=D2RIVOUT(ISEQ,1)+D2FLDOUT(ISEQ,1)+D2PTHOUT(ISEQ,1) - DRIVROF = ( D2RUNOFF(ISEQ,1)+D2GDWRTN(ISEQ,1) ) * ( 1._JPRB-D2FLDFRC(ISEQ,1) ) * DT - DFLDROF = ( D2RUNOFF(ISEQ,1)+D2GDWRTN(ISEQ,1) ) * D2FLDFRC(ISEQ,1) * DT - P2RIVSTO(ISEQ,1) = P2RIVSTO(ISEQ,1) + DRIVROF - P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) + DFLDROF + DRIVROF = ( D2RUNOFF(ISEQ,1)+D2GDWRTN(ISEQ,1) ) * ( 1._JPRB-D2FLDFRC(ISEQ,1) ) * DT + DFLDROF = ( D2RUNOFF(ISEQ,1)+D2GDWRTN(ISEQ,1) ) * D2FLDFRC(ISEQ,1) * DT + P2RIVSTO(ISEQ,1) = P2RIVSTO(ISEQ,1) + DRIVROF + P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) + DFLDROF - IF (LWEVAP) THEN - !! Find out amount of water to be extracted from flooplain reservoir - !! Assuming "water evaporation", multiplied by flood area fraction - !! Limited by total amount of flooplain storage - DWEVAPEX = MIN(P2FLDSTO(ISEQ,1),D2FLDFRC(ISEQ,1)*DT*D2WEVAP(ISEQ,1)*1._JPRD) - DWEVAPEX = MAX(DWEVAPEX,0.0D0) - P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) - DWEVAPEX - D2WEVAPEX(ISEQ,1) = DWEVAPEX/DT ! keept for output as flux - ENDIF + IF (LWEVAP) THEN + !! Find out amount of water to be extracted from flooplain reservoir + !! Assuming "water evaporation", multiplied by flood area fraction + !! Limited by total amount of flooplain storage + DWEVAPEX = MIN(P2FLDSTO(ISEQ,1),D2FLDFRC(ISEQ,1)*DT*D2WEVAP(ISEQ,1)*1._JPRD) + DWEVAPEX = MAX(DWEVAPEX,0.0D0) + P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) - DWEVAPEX + D2WEVAPEX(ISEQ,1) = DWEVAPEX/DT ! keept for output as flux + ENDIF - IF (LWINFILT) THEN - !! Find out amount of water to be extracted from flooplain reservoir - !! Assuming " water re-infiltration", multiplied by flood area fraction - !! Limited by total amount of flooplain storage - D2WINFILTEX = MIN(P2FLDSTO(ISEQ,1),D2FLDFRC(ISEQ,1)*DT*D2WINFILT(ISEQ,1)*1._JPRD) - P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) - DWINFILTEX - D2WINFILTEX(ISEQ,1) = DWINFILTEX/DT ! keept for output as flux - ENDIF - D2STORGE(ISEQ,1)=P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) - P0GLBSTONEW=P0GLBSTONEW+D2STORGE(ISEQ,1) - -END DO + IF (LWINFILT) THEN + !! Find out amount of water to be extracted from flooplain reservoir + !! Assuming " water re-infiltration", multiplied by flood area fraction + !! Limited by total amount of flooplain storage + D2WINFILTEX = MIN(P2FLDSTO(ISEQ,1),D2FLDFRC(ISEQ,1)*DT*D2WINFILT(ISEQ,1)*1._JPRD) + P2FLDSTO(ISEQ,1) = P2FLDSTO(ISEQ,1) - DWINFILTEX + D2WINFILTEX(ISEQ,1) = DWINFILTEX/DT ! keept for output as flux + ENDIF + D2STORGE(ISEQ,1)=P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) + P0GLBSTONEW=P0GLBSTONEW+D2STORGE(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -CONTAINS -!========================================================== -!+ CALC_GDWDLY -!+ -!+ -!========================================================== -SUBROUTINE CALC_GDWDLY -USE YOS_CMF_MAP, ONLY: NSEQALL,D2GDWDLY -IMPLICIT NONE -!*** LOCAL -REAL(KIND=JPRB) :: ZDTI -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ -REAL(KIND=JPRB),SAVE :: ZMULGW + CONTAINS + !========================================================== + !+ CALC_GDWDLY + !+ + !+ + !========================================================== + SUBROUTINE CALC_GDWDLY + USE YOS_CMF_MAP, only: NSEQALL,D2GDWDLY + IMPLICIT NONE + !*** LOCAL + real(KIND=JPRB) :: ZDTI + ! SAVE for OpenMP + integer(KIND=JPIM),SAVE :: ISEQ + real(KIND=JPRB),SAVE :: ZMULGW !$OMP THREADPRIVATE (ZMULGW) !===================================================== -ZDTI = 1._JPRB / DT ! Inverse time-step + ZDTI = 1._JPRB / DT ! Inverse time-step !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IF (D2GDWDLY(ISEQ,1)>0._JPRB) THEN - ! Only if GW delay > 0 - ZMULGW = 1._JPRB / ( ZDTI + 1._JPRB/D2GDWDLY(ISEQ,1) ) - P2GDWSTO(ISEQ,1) = ( D2ROFSUB(ISEQ,1) + P2GDWSTO(ISEQ,1)*ZDTI ) *ZMULGW - D2GDWRTN(ISEQ,1) = P2GDWSTO(ISEQ,1) / D2GDWDLY(ISEQ,1) - ELSE - ! Zero GW delay - P2GDWSTO(ISEQ,1) = 0._JPRD - D2GDWRTN(ISEQ,1) = D2ROFSUB(ISEQ,1) - ENDIF -ENDDO + DO ISEQ=1,NSEQALL + IF (D2GDWDLY(ISEQ,1)>0._JPRB) THEN + ! Only if GW delay > 0 + ZMULGW = 1._JPRB / ( ZDTI + 1._JPRB/D2GDWDLY(ISEQ,1) ) + P2GDWSTO(ISEQ,1) = ( D2ROFSUB(ISEQ,1) + P2GDWSTO(ISEQ,1)*ZDTI ) *ZMULGW + D2GDWRTN(ISEQ,1) = P2GDWSTO(ISEQ,1) / D2GDWDLY(ISEQ,1) + ELSE + ! Zero GW delay + P2GDWSTO(ISEQ,1) = 0._JPRD + D2GDWRTN(ISEQ,1) = D2ROFSUB(ISEQ,1) + ENDIF + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CALC_GDWDLY -!========================================================== + END SUBROUTINE CALC_GDWDLY + !========================================================== -END SUBROUTINE CMF_CALC_STONXT + END SUBROUTINE CMF_CALC_STONXT !#################################################################### END MODULE CMF_CALC_STONXT_MOD diff --git a/CaMa/src/cmf_ctrl_boundary_mod.F90 b/CaMa/src/cmf_ctrl_boundary_mod.F90 index 83c11e1e..d9bc286c 100755 --- a/CaMa/src/cmf_ctrl_boundary_mod.F90 +++ b/CaMa/src/cmf_ctrl_boundary_mod.F90 @@ -18,49 +18,49 @@ MODULE CMF_CTRL_BOUNDARY_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM, IFRQ_SL, DTSL -!============================ -IMPLICIT NONE -SAVE -!*** NAMELIST/NBOUND/ -! configulation -LOGICAL :: LSEALEVCDF !! true : netCDF sea level boundary -! plain binary data -CHARACTER(LEN=256) :: CSEALEVDIR !! Sea level boundary DIRECTORY -CHARACTER(LEN=256) :: CSEALEVPRE !! Sea level boundary PREFIX -CHARACTER(LEN=256) :: CSEALEVSUF !! Sea level boundary SUFFIX -! netCDF data -CHARACTER(LEN=256) :: CSEALEVCDF !! Sea level netCDF file name -CHARACTER(LEN=256) :: CVNSEALEV !! Sea Level netCDF variable name -! -INTEGER(KIND=JPIM) :: SYEARSL !! Start YEAR of netCDF sea level -INTEGER(KIND=JPIM) :: SMONSL !! Start MONTH of netCDF sea level -INTEGER(KIND=JPIM) :: SDAYSL !! Start DAY of netCDF sea level -INTEGER(KIND=JPIM) :: SHOURSL !! Start DAY of netCDF sea level -! for interporlation (netCDF only) -INTEGER(KIND=JPIM) :: NLINKS, NCDFSTAT !! Number of ser level station -CHARACTER(LEN=256) :: CSLMAP !! Conversion table (Sta -> XY) - -NAMELIST/NBOUND/ LSEALEVCDF, CSEALEVDIR, CSEALEVPRE, CSEALEVSUF,& - CSEALEVCDF, CVNSEALEV, SYEARSL, SMONSL, SDAYSL, SHOURSL, & - CSLMAP, IFRQ_SL + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM, IFRQ_SL, DTSL + !============================ + IMPLICIT NONE + SAVE + !*** NAMELIST/NBOUND/ + ! configulation + LOGICAL :: LSEALEVCDF !! true : netCDF sea level boundary + ! plain binary data + CHARACTER(LEN=256) :: CSEALEVDIR !! Sea level boundary DIRECTORY + CHARACTER(LEN=256) :: CSEALEVPRE !! Sea level boundary PREFIX + CHARACTER(LEN=256) :: CSEALEVSUF !! Sea level boundary SUFFIX + ! netCDF data + CHARACTER(LEN=256) :: CSEALEVCDF !! Sea level netCDF file name + CHARACTER(LEN=256) :: CVNSEALEV !! Sea Level netCDF variable name + ! + INTEGER(KIND=JPIM) :: SYEARSL !! Start YEAR of netCDF sea level + INTEGER(KIND=JPIM) :: SMONSL !! Start MONTH of netCDF sea level + INTEGER(KIND=JPIM) :: SDAYSL !! Start DAY of netCDF sea level + INTEGER(KIND=JPIM) :: SHOURSL !! Start DAY of netCDF sea level + ! for interporlation (netCDF only) + INTEGER(KIND=JPIM) :: NLINKS, NCDFSTAT !! Number of ser level station + CHARACTER(LEN=256) :: CSLMAP !! Conversion table (Sta -> XY) + + NAMELIST/NBOUND/ LSEALEVCDF, CSEALEVDIR, CSEALEVPRE, CSEALEVSUF,& + CSEALEVCDF, CVNSEALEV, SYEARSL, SMONSL, SDAYSL, SHOURSL, & + CSLMAP, IFRQ_SL !*** local variables #ifdef UseCDF_CMF -TYPE TYPESL -CHARACTER(LEN=256) :: CNAME !! Netcdf file name -CHARACTER(LEN=256) :: CVAR !! Netcdf variable name -INTEGER(KIND=JPIM) :: NCID !! Netcdf file ID -INTEGER(KIND=JPIM) :: NVARID !! Netcdf variable ID -INTEGER(KIND=JPIM) :: NSTAID !! Netcdf station ID -INTEGER(KIND=JPIM) :: NSTART !! start date of netcdf (KMIN) -INTEGER(KIND=JPIM) :: NSTEP !! steps in netCDF -END TYPE TYPESL -TYPE(TYPESL) :: SLCDF !! Derived type for Sea Level boundary - -REAL(KIND=JPRM),ALLOCATABLE :: R1SLIN(:) ! 1D input boundary condition (m) -INTEGER(KIND=JPIM),ALLOCATABLE :: I2SLMAP(:,:) + type TYPESL + CHARACTER(LEN=256) :: CNAME !! Netcdf file name + CHARACTER(LEN=256) :: CVAR !! Netcdf variable name + INTEGER(KIND=JPIM) :: NCID !! Netcdf file ID + INTEGER(KIND=JPIM) :: NVARID !! Netcdf variable ID + INTEGER(KIND=JPIM) :: NSTAID !! Netcdf station ID + INTEGER(KIND=JPIM) :: NSTART !! start date of netcdf (KMIN) + INTEGER(KIND=JPIM) :: NSTEP !! steps in netCDF + END type TYPESL + type(TYPESL) :: SLCDF !! Derived type for Sea Level boundary + + REAL(KIND=JPRM),ALLOCATABLE :: R1SLIN(:) ! 1D input boundary condition (m) + INTEGER(KIND=JPIM),ALLOCATABLE :: I2SLMAP(:,:) #endif CONTAINS @@ -70,331 +70,327 @@ MODULE CMF_CTRL_BOUNDARY_MOD ! -- CMF_BOUNDARY_UPDATE : Update sea level boundary from file ! -- CMF_BOUNDARY_END : Finalize boundary data file !#################################################################### -SUBROUTINE CMF_BOUNDARY_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE,LSEALEV -USE YOS_CMF_TIME, ONLY: YYYY0 -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 1. open namelist -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::BOUNDARY_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE - -!*** 2. default value -LSEALEVCDF=.FALSE. !! true for netcdf sea level data - -CSEALEVDIR="./sealev/" -CSEALEVPRE="sealev" -CSEALEVSUF=".bin" - -CSEALEVCDF="./sealev/" -CVNSEALEV="variable" -CSLMAP="./sealev/" - -SYEARSL=0 -SMONSL =0 -SDAYSL =0 -SHOURSL=0 - -IFRQ_SL= 9999 !! default: dynamic sea level not used - -!*** 3. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NBOUND) - -IF( LSEALEV )THEN - WRITE(LOGNAM,*) "=== NAMELIST, NBOUNDARY ===" - WRITE(LOGNAM,*) "LSEALEVCDF: ", LSEALEVCDF - IF( LSEALEVCDF )THEN - WRITE(LOGNAM,*) "CSEALEVCDF: ", TRIM(CSEALEVCDF) - WRITE(LOGNAM,*) "CVNSEALEV: ", TRIM(CVNSEALEV) - WRITE(LOGNAM,*) "SYEARSL: ", SYEARSL - WRITE(LOGNAM,*) "SMONSL: ", SMONSL - WRITE(LOGNAM,*) "SDAYSL: ", SDAYSL - WRITE(LOGNAM,*) "SHOURSL: ", SHOURSL - WRITE(LOGNAM,*) "CSLMAP: ", TRIM(CSLMAP) - ELSE - WRITE(LOGNAM,*) "CSEALEVDIR: ", TRIM(CSEALEVDIR) - WRITE(LOGNAM,*) "CSEALEVPRE: ", TRIM(CSEALEVPRE) - WRITE(LOGNAM,*) "CSEALEVSUF: ", TRIM(CSEALEVSUF) - ENDIF - WRITE(LOGNAM,*) "IFRQ_SL ", IFRQ_SL -ENDIF - -CLOSE(NSETFILE) - -!*** 4. modify base date (shared for KMIN) -IF( LSEALEV .and. LSEALEVCDF )THEN - YYYY0=MIN(YYYY0,SYEARSL) - YYYY0=MAX(YYYY0,0) -ENDIF - -DTSL = IFRQ_SL *60 !! min -> second - -WRITE(LOGNAM,*) "CMF::BOUNDARY_NMLIST: end" - -END SUBROUTINE CMF_BOUNDARY_NMLIST + SUBROUTINE CMF_BOUNDARY_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE,LSEALEV + USE YOS_CMF_TIME, only: YYYY0 + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 1. open namelist + NSETFILE=INQUIRE_FID() + OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::BOUNDARY_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE + + !*** 2. default value + LSEALEVCDF=.FALSE. !! true for netcdf sea level data + + CSEALEVDIR="./sealev/" + CSEALEVPRE="sealev" + CSEALEVSUF=".bin" + + CSEALEVCDF="./sealev/" + CVNSEALEV="variable" + CSLMAP="./sealev/" + + SYEARSL=0 + SMONSL =0 + SDAYSL =0 + SHOURSL=0 + + IFRQ_SL= 9999 !! default: dynamic sea level not used + + !*** 3. read namelist + rewind(NSETFILE) + read(NSETFILE,NML=NBOUND) + + IF( LSEALEV )THEN + write(LOGNAM,*) "=== NAMELIST, NBOUNDARY ===" + write(LOGNAM,*) "LSEALEVCDF: ", LSEALEVCDF + IF( LSEALEVCDF )THEN + write(LOGNAM,*) "CSEALEVCDF: ", TRIM(CSEALEVCDF) + write(LOGNAM,*) "CVNSEALEV: ", TRIM(CVNSEALEV) + write(LOGNAM,*) "SYEARSL: ", SYEARSL + write(LOGNAM,*) "SMONSL: ", SMONSL + write(LOGNAM,*) "SDAYSL: ", SDAYSL + write(LOGNAM,*) "SHOURSL: ", SHOURSL + write(LOGNAM,*) "CSLMAP: ", TRIM(CSLMAP) + ELSE + write(LOGNAM,*) "CSEALEVDIR: ", TRIM(CSEALEVDIR) + write(LOGNAM,*) "CSEALEVPRE: ", TRIM(CSEALEVPRE) + write(LOGNAM,*) "CSEALEVSUF: ", TRIM(CSEALEVSUF) + ENDIF + write(LOGNAM,*) "IFRQ_SL ", IFRQ_SL + ENDIF + + CLOSE(NSETFILE) + + !*** 4. modify base date (shared for KMIN) + IF( LSEALEV .and. LSEALEVCDF )THEN + YYYY0=MIN(YYYY0,SYEARSL) + YYYY0=MAX(YYYY0,0) + ENDIF + + DTSL = IFRQ_SL *60 !! min -> second + + write(LOGNAM,*) "CMF::BOUNDARY_NMLIST: end" + + END SUBROUTINE CMF_BOUNDARY_NMLIST !#################################################################### -!#################################################################### -SUBROUTINE CMF_BOUNDARY_INIT -USE YOS_CMF_MAP, ONLY: NSEQMAX, D2SEALEV + !#################################################################### + SUBROUTINE CMF_BOUNDARY_INIT + USE YOS_CMF_MAP, only: NSEQMAX, D2SEALEV -IMPLICIT NONE -!#################################################################### -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) "CMF::BOUNDARY_INIT: initialize boundary" + IMPLICIT NONE + !#################################################################### + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) "CMF::BOUNDARY_INIT: initialize boundary" -ALLOCATE( D2SEALEV(NSEQMAX,1) ) + allocate( D2SEALEV(NSEQMAX,1) ) -IF( LSEALEVCDF )THEN + IF( LSEALEVCDF )THEN #ifdef UseCDF_CMF - CALL CMF_BOUNDARY_INIT_CDF !! initialize sea level boundary (netCDF only) + CALL CMF_BOUNDARY_INIT_CDF !! initialize sea level boundary (netCDF only) #endif -ENDIF + ENDIF -WRITE(LOGNAM,*) "CMF::BOUNDARY_INIT: end" + write(LOGNAM,*) "CMF::BOUNDARY_INIT: end" #ifdef UseCDF_CMF -CONTAINS -!========================================================== -!+ CMF_BOUNDARY_INIT_CDF -!========================================================== -SUBROUTINE CMF_BOUNDARY_INIT_CDF -USE YOS_CMF_INPUT, ONLY: TMPNAM, DTSL -USE YOS_CMF_MAP, ONLY: I1NEXT, I2VECTOR -USE YOS_CMF_TIME, ONLY: KMINSTASL, KMINSTART, KMINEND -USE CMF_UTILS_MOD, ONLY: NCERROR, INQUIRE_FID, DATE2MIN -USE NETCDF -IMPLICIT NONE -!* Local Variables -INTEGER(KIND=JPIM) :: NTIMEID,NCDFSTP -INTEGER(KIND=JPIM) :: KMINENDSL -INTEGER(KIND=JPIM) :: IX, IY, IS, ILNK, ISEQ -! =============================================== -!*** 1. calculate KMINSTASL (START KMIN for boundary) -KMINSTASL = DATE2MIN(SYEARSL*10000+SMONSL*100+SDAYSL,SHOURSL*100) - -!*** 2. Initialize Type for sea level CDF -SLCDF%CNAME=TRIM(CSEALEVCDF) -SLCDF%CVAR=TRIM(CVNSEALEV) -SLCDF%NSTART=KMINSTASL -WRITE(LOGNAM,*) "CMF::BOUNRARY_INIT_CDF:", SLCDF%CNAME, SLCDF%NSTART -!*** Open netCDF sea level File -CALL NCERROR( NF90_OPEN(SLCDF%CNAME,NF90_NOWRITE,SLCDF%NCID),'OPENING :'//SLCDF%CNAME ) -CALL NCERROR( NF90_INQ_VARID(SLCDF%NCID,SLCDF%CVAR,SLCDF%NVARID) ) -CALL NCERROR( NF90_INQ_DIMID(SLCDF%NCID,'time',NTIMEID),'GETTING TIME ID Sea Level Boundary') -CALL NCERROR( NF90_INQUIRE_DIMENSION(NCID=SLCDF%NCID,DIMID=NTIMEID,LEN=NCDFSTP),'GETTING TIME LENGTH') -CALL NCERROR( NF90_INQ_DIMID(SLCDF%NCID, 'stations', SLCDF%NSTAID ), 'GETTING STATION ID' ) -CALL NCERROR( NF90_INQUIRE_DIMENSION(SLCDF%NCID, DIMID=SLCDF%NSTAID, LEN=NCDFSTAT ), 'GETTING STATION NUMBER' ) -ALLOCATE( R1SLIN(NCDFSTAT) ) ! 1D input boundary condition (m) - -WRITE(LOGNAM,*) "CMF::BOUNDARY_INIT_CDF: CNAME,NCID,VARID", TRIM(SLCDF%CNAME),SLCDF%NCID,SLCDF%NVARID - -!*** 4. check sealev forcing time -IF ( KMINSTART .LT. KMINSTASL ) THEN - WRITE(LOGNAM,*) "Run start earlier than boundary data", TRIM(SLCDF%CNAME), KMINSTART, KMINSTASL - STOP 9 -ENDIF - -KMINENDSL=KMINSTASL + NCDFSTP*INT(DTSL/60,JPIM) -IF ( KMINEND .GT. KMINENDSL ) THEN - WRITE(LOGNAM,*) "Run end later than sealev data", TRIM(SLCDF%CNAME), KMINEND, KMINENDSL - STOP 9 -ENDIF - -!*** 4. conversion table - -!! suggested new mapping format with X Y STATION columns -!! read formated mapping file and check if at river outlet and in NETCDF -TMPNAM=INQUIRE_FID() -OPEN(TMPNAM,FILE=CSLMAP,FORM='FORMATTED') -READ(TMPNAM,*) NLINKS - -WRITE(LOGNAM,*) "Dynamic sea level links", NLINKS - -ALLOCATE( I2SLMAP(3,NLINKS) ) ! conversion matrix (X Y STATION ) -DO ILNK=1, NLINKS - READ(TMPNAM,*) IX, IY, IS - ! check if links with river outlet cells - ISEQ=I2VECTOR(IX,IY) - IF( ISEQ>0 )THEN - IF( I1NEXT(ISEQ) .NE. -9 ) THEN - WRITE(LOGNAM,*) "Sealev link not at river outlet cell", IX, IY - STOP 9 - ! check if station index in netcdf - ELSEIF (IS .LT. 1 .or. IS .GT. NCDFSTAT) THEN - WRITE(LOGNAM,*) "Sealev link outside netcdf index", IS - STOP 9 - ENDIF - ELSE - WRITE(LOGNAM,*) "Sealev link outside land grids", IX,IY - STOP 9 - ENDIF - - I2SLMAP(1,ILNK) = IX - I2SLMAP(2,ILNK) = IY - I2SLMAP(3,ILNK) = IS -END DO -CLOSE(TMPNAM) - - -END SUBROUTINE CMF_BOUNDARY_INIT_CDF + CONTAINS + !========================================================== + !+ CMF_BOUNDARY_INIT_CDF + !========================================================== + SUBROUTINE CMF_BOUNDARY_INIT_CDF + USE YOS_CMF_INPUT, only: TMPNAM, DTSL + USE YOS_CMF_MAP, only: I1NEXT, I2VECTOR + USE YOS_CMF_TIME, only: KMINSTASL, KMINSTART, KMINEND + USE CMF_UTILS_MOD, only: NCERROR, INQUIRE_FID, DATE2MIN + USE NETCDF + IMPLICIT NONE + !* Local Variables + INTEGER(KIND=JPIM) :: NTIMEID,NCDFSTP + INTEGER(KIND=JPIM) :: KMINENDSL + INTEGER(KIND=JPIM) :: IX, IY, IS, ILNK, ISEQ + ! =============================================== + !*** 1. calculate KMINSTASL (START KMIN for boundary) + KMINSTASL = DATE2MIN(SYEARSL*10000+SMONSL*100+SDAYSL,SHOURSL*100) + + !*** 2. Initialize Type for sea level CDF + SLCDF%CNAME=TRIM(CSEALEVCDF) + SLCDF%CVAR=TRIM(CVNSEALEV) + SLCDF%NSTART=KMINSTASL + write(LOGNAM,*) "CMF::BOUNRARY_INIT_CDF:", SLCDF%CNAME, SLCDF%NSTART + !*** Open netCDF sea level File + CALL NCERROR( NF90_OPEN(SLCDF%CNAME,NF90_NOwrite,SLCDF%NCID),'OPENING :'//SLCDF%CNAME ) + CALL NCERROR( NF90_INQ_VARID(SLCDF%NCID,SLCDF%CVAR,SLCDF%NVARID) ) + CALL NCERROR( NF90_INQ_DIMID(SLCDF%NCID,'time',NTIMEID),'GETTING TIME ID Sea Level Boundary') + CALL NCERROR( NF90_INQUIRE_DIMENSION(NCID=SLCDF%NCID,DIMID=NTIMEID,LEN=NCDFSTP),'GETTING TIME LENGTH') + CALL NCERROR( NF90_INQ_DIMID(SLCDF%NCID, 'stations', SLCDF%NSTAID ), 'GETTING STATION ID' ) + CALL NCERROR( NF90_INQUIRE_DIMENSION(SLCDF%NCID, DIMID=SLCDF%NSTAID, LEN=NCDFSTAT ), 'GETTING STATION NUMBER' ) + allocate( R1SLIN(NCDFSTAT) ) ! 1D input boundary condition (m) + + write(LOGNAM,*) "CMF::BOUNDARY_INIT_CDF: CNAME,NCID,VARID", TRIM(SLCDF%CNAME),SLCDF%NCID,SLCDF%NVARID + + !*** 4. check sealev forcing time + IF ( KMINSTART .LT. KMINSTASL ) THEN + write(LOGNAM,*) "Run start earlier than boundary data", TRIM(SLCDF%CNAME), KMINSTART, KMINSTASL + STOP 9 + ENDIF + + KMINENDSL=KMINSTASL + NCDFSTP*INT(DTSL/60,JPIM) + IF ( KMINEND .GT. KMINENDSL ) THEN + write(LOGNAM,*) "Run end later than sealev data", TRIM(SLCDF%CNAME), KMINEND, KMINENDSL + STOP 9 + ENDIF + + !*** 4. conversion table + + !! suggested new mapping format with X Y STATION columns + !! read formated mapping file and check if at river outlet and in NETCDF + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CSLMAP,FORM='FORMATTED') + read(TMPNAM,*) NLINKS + + write(LOGNAM,*) "Dynamic sea level links", NLINKS + + allocate( I2SLMAP(3,NLINKS) ) ! conversion matrix (X Y STATION ) + DO ILNK=1, NLINKS + read(TMPNAM,*) IX, IY, IS + ! check if links with river outlet cells + ISEQ=I2VECTOR(IX,IY) + IF( ISEQ>0 )THEN + IF( I1NEXT(ISEQ) .NE. -9 ) THEN + write(LOGNAM,*) "Sealev link not at river outlet cell", IX, IY + STOP 9 + ! check if station index in netcdf + ELSEIF (IS .LT. 1 .or. IS .GT. NCDFSTAT) THEN + write(LOGNAM,*) "Sealev link outside netcdf index", IS + STOP 9 + ENDIF + ELSE + write(LOGNAM,*) "Sealev link outside land grids", IX,IY + STOP 9 + ENDIF + + I2SLMAP(1,ILNK) = IX + I2SLMAP(2,ILNK) = IY + I2SLMAP(3,ILNK) = IS + ENDDO + CLOSE(TMPNAM) + + + END SUBROUTINE CMF_BOUNDARY_INIT_CDF #endif !========================================================== -END SUBROUTINE CMF_BOUNDARY_INIT + END SUBROUTINE CMF_BOUNDARY_INIT !#################################################################### -!#################################################################### -SUBROUTINE CMF_BOUNDARY_UPDATE -! read runoff from file -USE YOS_CMF_INPUT, ONLY: LMEANSL, LSEALEV, IFRQ_SL -USE YOS_CMF_TIME, ONLY: IMIN, IYYYYMMDD, IHHMM -USE YOS_CMF_MAP, ONLY: D2DWNELV, D2ELEVTN, D2SEALEV, D2MEANSL -IMPLICIT NONE -!* local variable -INTEGER(KIND=JPIM) :: IUPDATE -!================================================ -IUPDATE=0 -IF( MOD( INT(IMIN),IFRQ_SL)==0 )THEN - IUPDATE=1 -ENDIF - - -IF( LSEALEV .and. IUPDATE==1 ) THEN - WRITE(LOGNAM,*) "CMF::BOUNDARY_UPDATE: update at time: ", IYYYYMMDD, IHHMM - - - IF( LSEALEVCDF )THEN -#ifdef UseCDF_CMF - CALL CMF_BOUNDARY_GET_CDF -#endif - ELSE - CALL CMF_BOUNDARY_GET_BIN - ENDIF -ENDIF + !#################################################################### + SUBROUTINE CMF_BOUNDARY_UPDATE + ! read runoff from file + USE YOS_CMF_INPUT, only: LMEANSL, LSEALEV, IFRQ_SL + USE YOS_CMF_TIME, only: IMIN, IYYYYMMDD, IHHMM + USE YOS_CMF_MAP, only: D2DWNELV, D2ELEVTN, D2SEALEV, D2MEANSL + IMPLICIT NONE + !* local variable + INTEGER(KIND=JPIM) :: IUPDATE + !================================================ + IUPDATE=0 + IF( MOD( INT(IMIN),IFRQ_SL)==0 )THEN + IUPDATE=1 + ENDIF -IF( LMEANSL ) THEN - D2DWNELV(:,:)=D2ELEVTN(:,:) + D2MEANSL(:,:) -ELSE - D2DWNELV(:,:)=D2ELEVTN(:,:) -ENDIF -IF( LSEALEV ) THEN - D2DWNELV(:,:)=D2DWNELV(:,:) + D2SEALEV(:,:) -ENDIF + IF( LSEALEV .and. IUPDATE==1 ) THEN + write(LOGNAM,*) "CMF::BOUNDARY_UPDATE: update at time: ", IYYYYMMDD, IHHMM -CONTAINS -!========================================================== -!+ CMF_BOUNDARY_GET_BIN -!+ CMF_BOUNDARY_GET_CDF -!========================================================== -SUBROUTINE CMF_BOUNDARY_GET_BIN -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX, NY -USE YOS_CMF_TIME, ONLY: IYYYY, IMM, IDD, IHHMM -USE YOS_CMF_MAP, ONLY: D2SEALEV -USE CMF_UTILS_MOD, ONLY: mapR2vecD,INQUIRE_FID -IMPLICIT NONE -CHARACTER(LEN=256) :: CIFNAME !! INPUT FILE -CHARACTER(LEN=256) :: CDATE !! -REAL(KIND=JPRM) :: R2TMP(NX,NY) -!==================== -!*** 1. set file name -WRITE(CDATE,'(I4.4,I2.2,I2.2,I4.4)') IYYYY,IMM,IDD,IHHMM -CIFNAME = TRIM(CSEALEVDIR)//'/'//TRIM(CSEALEVPRE)//TRIM(CDATE)//TRIM(CSEALEVSUF) -WRITE(LOGNAM,*) "CMF::BOUNDARY_GET_BIN: read sealev:",TRIM(CIFNAME) - -!*** open & read sea level -TMPNAM=INQUIRE_FID() -OPEN(TMPNAM,FILE=CIFNAME,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TMP -CLOSE(TMPNAM) -CALL mapR2vecD(R2TMP,D2SEALEV) - -END SUBROUTINE CMF_BOUNDARY_GET_BIN -!========================================================== -!+ -!+ -!+ -!========================================================== + + IF( LSEALEVCDF )THEN #ifdef UseCDF_CMF -SUBROUTINE CMF_BOUNDARY_GET_CDF -USE YOS_CMF_INPUT, ONLY: DTSL, NX, NY -USE YOS_CMF_TIME, ONLY: KMIN -USE YOS_CMF_MAP, ONLY: D2SEALEV -USE CMF_UTILS_MOD, ONLY: NCERROR, mapR2vecD -USE NETCDF -IMPLICIT NONE -!* Local variables -INTEGER(KIND=JPIM) :: IRECSL, IX, IY, IS, ILNK -REAL(KIND=JPRM) :: R2TMP(NX,NY) -!=============== -!*** 1. calculate irec -IRECSL = ( KMIN-SLCDF%NSTART )*60_JPIM / INT(DTSL,JPIM) + 1 !! (second from netcdf start time) / (input time step) -WRITE(LOGNAM,*) "CMF::BOUNDARY_GET_CDF:", TRIM(SLCDF%CNAME), IRECSL - -!*** 2. read sea level -CALL NCERROR( NF90_GET_VAR(SLCDF%NCID,SLCDF%NVARID,R1SLIN,(/1,IRECSL/),(/NCDFSTAT,1/)),'READING SEA LEVEL' ) - -!*** 3. convert 1D station data -> 2D map -R2TMP(:,:)=0.E0 -DO ILNK = 1, NLINKS - IX = I2SLMAP(1,ILNK) - IY = I2SLMAP(2,ILNK) - IS = I2SLMAP(3,ILNK) - R2TMP(IX,IY) = R1SLIN(IS) -END DO -CALL mapR2vecD(R2TMP,D2SEALEV) - -END SUBROUTINE CMF_BOUNDARY_GET_CDF + CALL CMF_BOUNDARY_GET_CDF +#endif + ELSE + CALL CMF_BOUNDARY_GET_BIN + ENDIF + ENDIF + + IF( LMEANSL ) THEN + D2DWNELV(:,:)=D2ELEVTN(:,:) + D2MEANSL(:,:) + ELSE + D2DWNELV(:,:)=D2ELEVTN(:,:) + ENDIF + + IF( LSEALEV ) THEN + D2DWNELV(:,:)=D2DWNELV(:,:) + D2SEALEV(:,:) + ENDIF + + CONTAINS + !========================================================== + !+ CMF_BOUNDARY_GET_BIN + !+ CMF_BOUNDARY_GET_CDF + !========================================================== + SUBROUTINE CMF_BOUNDARY_GET_BIN + USE YOS_CMF_INPUT, only: TMPNAM, NX, NY + USE YOS_CMF_TIME, only: IYYYY, IMM, IDD, IHHMM + USE YOS_CMF_MAP, only: D2SEALEV + USE CMF_UTILS_MOD, only: mapR2vecD,INQUIRE_FID + IMPLICIT NONE + CHARACTER(LEN=256) :: CIFNAME !! INPUT FILE + CHARACTER(LEN=256) :: CDATE !! + REAL(KIND=JPRM) :: R2TMP(NX,NY) + !==================== + !*** 1. set file name + write(CDATE,'(I4.4,I2.2,I2.2,I4.4)') IYYYY,IMM,IDD,IHHMM + CIFNAME = TRIM(CSEALEVDIR)//'/'//TRIM(CSEALEVPRE)//TRIM(CDATE)//TRIM(CSEALEVSUF) + write(LOGNAM,*) "CMF::BOUNDARY_GET_BIN: read sealev:",TRIM(CIFNAME) + + !*** open & read sea level + TMPNAM=INQUIRE_FID() + OPEN(TMPNAM,FILE=CIFNAME,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TMP + CLOSE(TMPNAM) + CALL mapR2vecD(R2TMP,D2SEALEV) + + END SUBROUTINE CMF_BOUNDARY_GET_BIN + !========================================================== + !+ + !+ + !+ + !========================================================== +#ifdef UseCDF_CMF + SUBROUTINE CMF_BOUNDARY_GET_CDF + USE YOS_CMF_INPUT, only: DTSL, NX, NY + USE YOS_CMF_TIME, only: KMIN + USE YOS_CMF_MAP, only: D2SEALEV + USE CMF_UTILS_MOD, only: NCERROR, mapR2vecD + USE NETCDF + IMPLICIT NONE + !* Local variables + INTEGER(KIND=JPIM) :: IRECSL, IX, IY, IS, ILNK + REAL(KIND=JPRM) :: R2TMP(NX,NY) + !=============== + !*** 1. calculate irec + IRECSL = ( KMIN-SLCDF%NSTART )*60_JPIM / INT(DTSL,JPIM) + 1 !! (second from netcdf start time) / (input time step) + write(LOGNAM,*) "CMF::BOUNDARY_GET_CDF:", TRIM(SLCDF%CNAME), IRECSL + + !*** 2. read sea level + CALL NCERROR( NF90_GET_VAR(SLCDF%NCID,SLCDF%NVARID,R1SLIN,(/1,IRECSL/),(/NCDFSTAT,1/)),'READING SEA LEVEL' ) + + !*** 3. convert 1D station data -> 2D map + R2TMP(:,:)=0.E0 + DO ILNK = 1, NLINKS + IX = I2SLMAP(1,ILNK) + IY = I2SLMAP(2,ILNK) + IS = I2SLMAP(3,ILNK) + R2TMP(IX,IY) = R1SLIN(IS) + ENDDO + CALL mapR2vecD(R2TMP,D2SEALEV) + + END SUBROUTINE CMF_BOUNDARY_GET_CDF #endif !========================================================== -END SUBROUTINE CMF_BOUNDARY_UPDATE + END SUBROUTINE CMF_BOUNDARY_UPDATE !#################################################################### - - - - -!#################################################################### -SUBROUTINE CMF_BOUNDARY_END + !#################################################################### + SUBROUTINE CMF_BOUNDARY_END #ifdef UseCDF_CMF -USE CMF_UTILS_MOD, ONLY: NCERROR -USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR + USE NETCDF #endif -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "CMF::BOUNDARY_END: Finalize boundary module" + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "CMF::BOUNDARY_END: Finalize boundary module" -IF( LSEALEVCDF )THEN + IF( LSEALEVCDF )THEN #ifdef UseCDF_CMF - CALL NCERROR( NF90_CLOSE(SLCDF%NCID)) - WRITE(LOGNAM,*) "Input netcdf sealev closed:",SLCDF%NCID + CALL NCERROR( NF90_CLOSE(SLCDF%NCID)) + write(LOGNAM,*) "Input netcdf sealev closed:",SLCDF%NCID #endif -ENDIF + ENDIF -WRITE(LOGNAM,*) "CMF::BOUNDARY_END: end" + write(LOGNAM,*) "CMF::BOUNDARY_END: end" -END SUBROUTINE CMF_BOUNDARY_END -!#################################################################### + END SUBROUTINE CMF_BOUNDARY_END + !#################################################################### END MODULE CMF_CTRL_BOUNDARY_MOD diff --git a/CaMa/src/cmf_ctrl_damout_mod.F90 b/CaMa/src/cmf_ctrl_damout_mod.F90 index d904b05b..f1ca384b 100644 --- a/CaMa/src/cmf_ctrl_damout_mod.F90 +++ b/CaMa/src/cmf_ctrl_damout_mod.F90 @@ -1074,3 +1074,4 @@ END SUBROUTINE CMF_DAMOUT_WRTE END MODULE CMF_CTRL_DAMOUT_MOD + diff --git a/CaMa/src/cmf_ctrl_forcing_mod.F90 b/CaMa/src/cmf_ctrl_forcing_mod.F90 index 317586b5..644dc442 100755 --- a/CaMa/src/cmf_ctrl_forcing_mod.F90 +++ b/CaMa/src/cmf_ctrl_forcing_mod.F90 @@ -21,68 +21,68 @@ MODULE CMF_CTRL_FORCING_MOD ! Modified by Zhongwang Wei @ SYSU 2022.11.20 -!========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM -!============================ -IMPLICIT NONE -SAVE -!*** NAMELIST/NFORCE/ -! Forcing configulation / foprcing mapping table "input matrix" -LOGICAL :: LINPCDF !! true : netCDF runoff forcing -LOGICAL :: LINPEND !! true for input endian conversion - -LOGICAL :: LINTERP !! true : runoff interpolation using input matrix -LOGICAL :: LITRPCDF !! true : netCDF input matrix file -CHARACTER(LEN=256) :: CINPMAT !! Input matrix filename -REAL(KIND=JPRB) :: DROFUNIT !! runoff unit conversion ( InpUnit/DROFUNIT = m3/m2/s) -! Binary forcing (total runoff / surface runoff when LROSPLIT) -CHARACTER(LEN=256) :: CROFDIR !! Forcing: runoff directory -CHARACTER(LEN=256) :: CROFPRE !! Forcing: runoff prefix -CHARACTER(LEN=256) :: CROFSUF !! Forcing: runoff suffix -! -CHARACTER(LEN=256) :: CSUBDIR !! Forcing: sub-surface runoff directory -CHARACTER(LEN=256) :: CSUBPRE !! Forcing: sub-surface runoff prefix -CHARACTER(LEN=256) :: CSUBSUF !! Forcing: sub-surface runoff suffix -! netCDF Forcing -CHARACTER(LEN=256) :: CROFCDF !! Netcdf forcing file file -CHARACTER(LEN=256) :: CVNROF !! NetCDF VARNAME of runoff. Default "runoff"/ -CHARACTER(LEN=256) :: CVNSUB !! NetCDF VARNAME of sub-surface runoff. - -INTEGER(KIND=JPIM) :: SYEARIN !! START YEAR IN NETCDF INPUT RUNOFF -INTEGER(KIND=JPIM) :: SMONIN !! START MONTH IN NETCDF INPUT RUNOFF -INTEGER(KIND=JPIM) :: SDAYIN !! START DAY IN NETCDF INPUT RUNOFF -INTEGER(KIND=JPIM) :: SHOURIN !! START HOUR IN NETCDF INPUT RUNOFF - -NAMELIST/NFORCE/ LINTERP, LINPEND, LINPCDF, LITRPCDF, CINPMAT, DROFUNIT, & - CROFDIR,CROFPRE, CROFSUF, CSUBDIR, CSUBPRE, CSUBSUF, & - CROFCDF,CVNROF, CVNSUB, SYEARIN, SMONIN,SDAYIN,SHOURIN - -!* local variable -INTEGER(KIND=JPIM) :: NCID !! netCDF file ID -INTEGER(KIND=JPIM) :: NVARID(2) !! netCDF variable ID + !========================================================== + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM + !============================ + IMPLICIT NONE + SAVE + !*** NAMELIST/NFORCE/ + ! Forcing configulation / foprcing mapping table "input matrix" + logical :: LINPCDF !! true : netCDF runoff forcing + logical :: LINPEND !! true for input endian conversion + + logical :: LINTERP !! true : runoff interpolation using input matrix + logical :: LITRPCDF !! true : netCDF input matrix file + character(LEN=256) :: CINPMAT !! Input matrix filename + real(KIND=JPRB) :: DROFUNIT !! runoff unit conversion ( InpUnit/DROFUNIT = m3/m2/s) + ! Binary forcing (total runoff / surface runoff when LROSPLIT) + character(LEN=256) :: CROFDIR !! Forcing: runoff directory + character(LEN=256) :: CROFPRE !! Forcing: runoff prefix + character(LEN=256) :: CROFSUF !! Forcing: runoff suffix + ! + character(LEN=256) :: CSUBDIR !! Forcing: sub-surface runoff directory + character(LEN=256) :: CSUBPRE !! Forcing: sub-surface runoff prefix + character(LEN=256) :: CSUBSUF !! Forcing: sub-surface runoff suffix + ! netCDF Forcing + character(LEN=256) :: CROFCDF !! Netcdf forcing file file + character(LEN=256) :: CVNROF !! NetCDF VARNAME of runoff. Default "runoff"/ + character(LEN=256) :: CVNSUB !! NetCDF VARNAME of sub-surface runoff. + + integer(KIND=JPIM) :: SYEARIN !! START YEAR IN NETCDF INPUT RUNOFF + integer(KIND=JPIM) :: SMONIN !! START MONTH IN NETCDF INPUT RUNOFF + integer(KIND=JPIM) :: SDAYIN !! START DAY IN NETCDF INPUT RUNOFF + integer(KIND=JPIM) :: SHOURIN !! START HOUR IN NETCDF INPUT RUNOFF + + NAMELIST/NFORCE/ LINTERP, LINPEND, LINPCDF, LITRPCDF, CINPMAT, DROFUNIT, & + CROFDIR,CROFPRE, CROFSUF, CSUBDIR, CSUBPRE, CSUBSUF, & + CROFCDF,CVNROF, CVNSUB, SYEARIN, SMONIN,SDAYIN,SHOURIN + + !* local variable + integer(KIND=JPIM) :: NCID !! netCDF file ID + integer(KIND=JPIM) :: NVARID(2) !! netCDF variable ID #ifdef UseCDF_CMF -TYPE TYPEROF -CHARACTER(LEN=256) :: CNAME !! netCDF file name -CHARACTER(LEN=256) :: CVAR(4) !! netCDF variable name -INTEGER(KIND=JPIM) :: NCID !! netCDF file ID -INTEGER(KIND=JPIM) :: NVARID(4) !! netCDF variable ID -INTEGER(KIND=JPIM) :: NSTART !! Start date of netNDF (in KMIN) -END TYPE TYPEROF -TYPE(TYPEROF) :: ROFCDF !! Derived type for Runoff input + type TYPEROF + character(LEN=256) :: CNAME !! netCDF file name + character(LEN=256) :: CVAR(4) !! netCDF variable name + integer(KIND=JPIM) :: NCID !! netCDF file ID + integer(KIND=JPIM) :: NVARID(4) !! netCDF variable ID + integer(KIND=JPIM) :: NSTART !! Start date of netNDF (in KMIN) + END type TYPEROF + type(TYPEROF) :: ROFCDF !! Derived type for Runoff input #endif -! input matrix (converted from NX:NY*INPN to NSEQMAX*INPN) -INTEGER(KIND=JPIM),ALLOCATABLE :: INPX(:,:) !! INPUT GRID XIN -INTEGER(KIND=JPIM),ALLOCATABLE :: INPY(:,:) !! INPUT GRID YIN -REAL(KIND=JPRB),ALLOCATABLE :: INPA(:,:) !! INPUT AREA + ! input matrix (converted from NX:NY*INPN to NSEQMAX*INPN) + integer(KIND=JPIM),ALLOCATABLE :: INPX(:,:) !! INPUT GRID XIN + integer(KIND=JPIM),ALLOCATABLE :: INPY(:,:) !! INPUT GRID YIN + real(KIND=JPRB),ALLOCATABLE :: INPA(:,:) !! INPUT AREA -! input matrix Inverse -INTEGER(KIND=JPIM),ALLOCATABLE :: INPXI(:,:,:) !! OUTPUT GRID XOUT -INTEGER(KIND=JPIM),ALLOCATABLE :: INPYI(:,:,:) !! OUTPUT GRID YOUT -REAL(KIND=JPRB),ALLOCATABLE :: INPAI(:,:,:) !! OUTPUT AREA -INTEGER(KIND=JPIM) :: INPNI !! MAX INPUT NUMBER for inverse interpolation + ! input matrix Inverse + integer(KIND=JPIM),ALLOCATABLE :: INPXI(:,:,:) !! OUTPUT GRID XOUT + integer(KIND=JPIM),ALLOCATABLE :: INPYI(:,:,:) !! OUTPUT GRID YOUT + real(KIND=JPRB),ALLOCATABLE :: INPAI(:,:,:) !! OUTPUT AREA + integer(KIND=JPIM) :: INPNI !! MAX INPUT NUMBER for inverse interpolation CONTAINS @@ -94,197 +94,197 @@ MODULE CMF_CTRL_FORCING_MOD ! -- CMF_FORCING_END : Finalize forcing data file ! !#################################################################### -SUBROUTINE CMF_FORCING_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE,LROSPLIT -USE YOS_CMF_TIME, ONLY: YYYY0 -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 1. open namelist -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::FORCING_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE - -!*** 2. default value -LINPCDF =.FALSE. -LINPEND =.FALSE. -LINTERP =.FALSE. -LITRPCDF=.FALSE. -CINPMAT ="NONE" -DROFUNIT=1._JPRB !! defaults mm/day -> m3/m2/s - -CROFDIR="./runoff/" -CROFPRE="Roff____" !! defaults runoff file name Roff____YYYYMMDD.one -CROFSUF=".one" - -CSUBDIR="./runoff/" -CSUBPRE="Rsub____" !! defaults runoff file name Rsub____YYYYMMDD.one -CSUBSUF=".one" - -CROFCDF="NONE" -CVNROF ="runoff" -CVNSUB ="NONE" -IF( LROSPLIT )THEN - CVNROF="Qs" - CVNSUB="Qsb" -ENDIF - -SYEARIN=0 !! netCDF input file start date (set to 0 when not used) -SMONIN =0 -SDAYIN =0 -SHOURIN=0 - -!*** 3. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NFORCE) - -WRITE(LOGNAM,*) "=== NAMELIST, NFORCE ===" -WRITE(LOGNAM,*) "LINPCDF: ", LINPCDF -WRITE(LOGNAM,*) "LINTERP: ", LINTERP -WRITE(LOGNAM,*) "LITRPCDF: ", LITRPCDF -WRITE(LOGNAM,*) "CINPMAT: ", TRIM(CINPMAT) -WRITE(LOGNAM,*) "LROSPLIT: ", LROSPLIT -IF( .not. LINPCDF )THEN - WRITE(LOGNAM,*) "CROFDIR: ", TRIM(CROFDIR) - WRITE(LOGNAM,*) "CROFPRE: ", TRIM(CROFPRE) - WRITE(LOGNAM,*) "CROFSUF: ", TRIM(CROFSUF) - IF( LROSPLIT )THEN - WRITE(LOGNAM,*) "CSUBDIR: ", TRIM(CSUBDIR) - WRITE(LOGNAM,*) "CSUBPRE: ", TRIM(CSUBPRE) - WRITE(LOGNAM,*) "CSUBSUF: ", TRIM(CSUBSUF) - ENDIF -ELSE - WRITE(LOGNAM,*) "CROFCDF: ", TRIM(CROFCDF) - WRITE(LOGNAM,*) "CVNROF: ", TRIM(CVNROF) - IF( LROSPLIT )THEN - WRITE(LOGNAM,*) "CVNSUB: ", TRIM(CVNSUB) - ENDIF - WRITE(LOGNAM,*) "SYEARIN,SMONIN,SDAYIN,SHOURIN ", SYEARIN,SMONIN,SDAYIN,SHOURIN -ENDIF -IF( LINPEND )THEN - WRITE(LOGNAM,*) "LINPEND: ", LINPEND -ENDIF - -CLOSE(NSETFILE) - -!*** 4. modify base date (shared for KMIN) -IF( LINPCDF )THEN - YYYY0=MIN(YYYY0,SYEARIN) -ENDIF - -WRITE(LOGNAM,*) "CMF::FORCING_NMLIST: end" - -END SUBROUTINE CMF_FORCING_NMLIST -!#################################################################### + SUBROUTINE CMF_FORCING_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE,LROSPLIT + USE YOS_CMF_TIME, only: YYYY0 + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 1. open namelist + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::FORCING_NMLIST: namelist open in unit: ", TRIM(CSETFILE), NSETFILE + + !*** 2. default value + LINPCDF =.FALSE. + LINPEND =.FALSE. + LINTERP =.FALSE. + LITRPCDF=.FALSE. + CINPMAT ="NONE" + DROFUNIT=1._JPRB !! defaults mm/day -> m3/m2/s + + CROFDIR="./runoff/" + CROFPRE="Roff____" !! defaults runoff file name Roff____YYYYMMDD.one + CROFSUF=".one" + + CSUBDIR="./runoff/" + CSUBPRE="Rsub____" !! defaults runoff file name Rsub____YYYYMMDD.one + CSUBSUF=".one" + + CROFCDF="NONE" + CVNROF ="runoff" + CVNSUB ="NONE" + IF( LROSPLIT )THEN + CVNROF="Qs" + CVNSUB="Qsb" + ENDIF + + SYEARIN=0 !! netCDF input file start date (set to 0 when not used) + SMONIN =0 + SDAYIN =0 + SHOURIN=0 + + !*** 3. read namelist + rewind(NSETFILE) + read(NSETFILE,NML=NFORCE) + + write(LOGNAM,*) "=== NAMELIST, NFORCE ===" + write(LOGNAM,*) "LINPCDF: ", LINPCDF + write(LOGNAM,*) "LINTERP: ", LINTERP + write(LOGNAM,*) "LITRPCDF: ", LITRPCDF + write(LOGNAM,*) "CINPMAT: ", TRIM(CINPMAT) + write(LOGNAM,*) "LROSPLIT: ", LROSPLIT + IF( .not. LINPCDF )THEN + write(LOGNAM,*) "CROFDIR: ", TRIM(CROFDIR) + write(LOGNAM,*) "CROFPRE: ", TRIM(CROFPRE) + write(LOGNAM,*) "CROFSUF: ", TRIM(CROFSUF) + IF( LROSPLIT )THEN + write(LOGNAM,*) "CSUBDIR: ", TRIM(CSUBDIR) + write(LOGNAM,*) "CSUBPRE: ", TRIM(CSUBPRE) + write(LOGNAM,*) "CSUBSUF: ", TRIM(CSUBSUF) + ENDIF + ELSE + write(LOGNAM,*) "CROFCDF: ", TRIM(CROFCDF) + write(LOGNAM,*) "CVNROF: ", TRIM(CVNROF) + IF( LROSPLIT )THEN + write(LOGNAM,*) "CVNSUB: ", TRIM(CVNSUB) + ENDIF + write(LOGNAM,*) "SYEARIN,SMONIN,SDAYIN,SHOURIN ", SYEARIN,SMONIN,SDAYIN,SHOURIN + ENDIF + IF( LINPEND )THEN + write(LOGNAM,*) "LINPEND: ", LINPEND + ENDIF + + close(NSETFILE) + !*** 4. modify base date (shared for KMIN) + IF( LINPCDF )THEN + YYYY0=MIN(YYYY0,SYEARIN) + ENDIF + write(LOGNAM,*) "CMF::FORCING_NMLIST: end" + END SUBROUTINE CMF_FORCING_NMLIST + !#################################################################### -!#################################################################### -SUBROUTINE CMF_FORCING_INIT -! Initialize/open netcdf input -! -- called from "Main Program / Coupler" -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) "CMF::FORCING_INIT: Initialize runoff forcing file (only for netCDF)" -IF( LINPCDF ) THEN + + + !#################################################################### + SUBROUTINE CMF_FORCING_INIT + ! Initialize/open netcdf input + ! -- called from "Main Program / Coupler" + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + write(LOGNAM,*) "CMF::FORCING_INIT: Initialize runoff forcing file (only for netCDF)" + IF( LINPCDF ) THEN #ifdef UseCDF_CMF - CALL CMF_FORCING_INIT_CDF + CALL CMF_FORCING_INIT_CDF #endif -ENDIF -IF( LINTERP ) THEN - IF( LITRPCDF )THEN + ENDIF + IF( LINTERP ) THEN + IF( LITRPCDF )THEN #ifdef UseCDF_CMF - CALL CMF_INPMAT_INIT_CDF + CALL CMF_INPMAT_INIT_CDF #endif - ELSE - CALL CMF_INPMAT_INIT_BIN - ENDIF -ENDIF + ELSE + CALL CMF_INPMAT_INIT_BIN + ENDIF + ENDIF -WRITE(LOGNAM,*) "CMF::FORCING_INIT: end" + write(LOGNAM,*) "CMF::FORCING_INIT: end" -CONTAINS + CONTAINS !========================================================== !+ CMF_FORCING_INIT_CDF : open netCDF forcing !+ CMF_INPMAT_INIT_CDF : open runoff interporlation matrix (inpmat) !+ CMF_INPMAT_INIT_BIN : open runoff interporlation matrix (inpmat) !========================================================== #ifdef UseCDF_CMF -SUBROUTINE CMF_FORCING_INIT_CDF -USE YOS_CMF_INPUT, ONLY: LROSPLIT, LWEVAP, LWINFILT, DTIN -USE YOS_CMF_TIME, ONLY: KMINSTAIN, KMINSTART, KMINEND -USE CMF_UTILS_MOD, ONLY: NCERROR, DATE2MIN -USE NETCDF -IMPLICIT NONE -!* Local Variables -INTEGER(KIND=JPIM) :: NTIMEID,NCDFSTP -INTEGER(KIND=JPIM) :: KMINENDIN -!================================================ -!*** 1. calculate KMINSTAINP (start KMIN for forcing) -KMINSTAIN=DATE2MIN(SYEARIN*10000+SMONIN*100+SDAYIN,SHOURIN*100) - -!*** 2. Initialize Type for Runoff CDF: -ROFCDF%CNAME=TRIM(CROFCDF) -ROFCDF%CVAR(1)=TRIM(CVNROF) -ROFCDF%CVAR(2)=TRIM(CVNSUB) -IF ( .not. LROSPLIT ) THEN - ROFCDF%CVAR(2)="NONE" - ROFCDF%NVARID(2)=-1 -ENDIF -IF ( .NOT. LWEVAP ) THEN - ROFCDF%CVAR(3)="NONE" - ROFCDF%NVARID(3)=-1 -ENDIF -! add water re-infiltration calculation -IF ( .NOT. LWINFILT ) THEN - ROFCDF%CVAR(4)="NONE" - ROFCDF%NVARID(4)=-1 -ENDIF -ROFCDF%NSTART=KMINSTAIN -WRITE(LOGNAM,*) "CMF::FORCING_INIT_CDF:", TRIM(ROFCDF%CNAME), TRIM(ROFCDF%CVAR(1)) - -!*** 3. Open netCDF ruoff file -CALL NCERROR( NF90_OPEN(TRIM(ROFCDF%CNAME),NF90_NOWRITE,ROFCDF%NCID),'OPENING :'//ROFCDF%CNAME ) -CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,TRIM(ROFCDF%CVAR(1)),ROFCDF%NVARID(1)) ) - -IF ( LROSPLIT ) THEN - CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,ROFCDF%CVAR(2),ROFCDF%NVARID(2)) ) -ENDIF -IF ( LWEVAP ) THEN - CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,ROFCDF%CVAR(3),ROFCDF%NVARID(3)) ) -ENDIF -! add water re-infiltration calculation -IF ( LWINFILT ) THEN - CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,ROFCDF%CVAR(4),ROFCDF%NVARID(4)) ) -ENDIF -CALL NCERROR( NF90_INQ_DIMID(ROFCDF%NCID,'time',NTIMEID),'GETTING TIME ID FORCING RUNOFF') -CALL NCERROR( NF90_INQUIRE_DIMENSION(NCID=ROFCDF%NCID,DIMID=NTIMEID,LEN=NCDFSTP),'GETTING TIME LENGTH') - -WRITE(LOGNAM,*) "CMF::FORCING_INIT_CDF: CNAME,NCID,VARID", TRIM(ROFCDF%CNAME),ROFCDF%NCID,ROFCDF%NVARID(1) - -!*** 4. check runoff forcing time -IF ( KMINSTART .LT. KMINSTAIN ) THEN - WRITE(LOGNAM,*) "Run start earlier than forcing data", TRIM(ROFCDF%CNAME), KMINSTART, KMINSTAIN - STOP 9 -ENDIF - -KMINENDIN=KMINSTAIN + NCDFSTP*INT(DTIN/60,JPIM) -IF ( KMINEND .GT. KMINENDIN ) THEN - WRITE(LOGNAM,*) "Run end later than forcing data", TRIM(ROFCDF%CNAME), KMINEND, KMINENDIN - STOP 9 -ENDIF - -END SUBROUTINE CMF_FORCING_INIT_CDF + SUBROUTINE CMF_FORCING_INIT_CDF + USE YOS_CMF_INPUT, only: LROSPLIT, LWEVAP, LWINFILT, DTIN + USE YOS_CMF_TIME, only: KMINSTAIN, KMINSTART, KMINEND + USE CMF_UTILS_MOD, only: NCERROR, DATE2MIN + USE NETCDF + IMPLICIT NONE + !* Local Variables + integer(KIND=JPIM) :: NTIMEID,NCDFSTP + integer(KIND=JPIM) :: KMINENDIN + !================================================ + !*** 1. calculate KMINSTAINP (start KMIN for forcing) + KMINSTAIN=DATE2MIN(SYEARIN*10000+SMONIN*100+SDAYIN,SHOURIN*100) + + !*** 2. Initialize Type for Runoff CDF: + ROFCDF%CNAME=TRIM(CROFCDF) + ROFCDF%CVAR(1)=TRIM(CVNROF) + ROFCDF%CVAR(2)=TRIM(CVNSUB) + IF ( .not. LROSPLIT ) THEN + ROFCDF%CVAR(2)="NONE" + ROFCDF%NVARID(2)=-1 + ENDIF + IF ( .not. LWEVAP ) THEN + ROFCDF%CVAR(3)="NONE" + ROFCDF%NVARID(3)=-1 + ENDIF + ! add water re-infiltration calculation + IF ( .not. LWINFILT ) THEN + ROFCDF%CVAR(4)="NONE" + ROFCDF%NVARID(4)=-1 + ENDIF + ROFCDF%NSTART=KMINSTAIN + write(LOGNAM,*) "CMF::FORCING_INIT_CDF:", TRIM(ROFCDF%CNAME), TRIM(ROFCDF%CVAR(1)) + + !*** 3. Open netCDF ruoff file + CALL NCERROR( NF90_OPEN(TRIM(ROFCDF%CNAME),NF90_NOWRITE,ROFCDF%NCID),'OPENING :'//ROFCDF%CNAME ) + CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,TRIM(ROFCDF%CVAR(1)),ROFCDF%NVARID(1)) ) + + IF ( LROSPLIT ) THEN + CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,ROFCDF%CVAR(2),ROFCDF%NVARID(2)) ) + ENDIF + IF ( LWEVAP ) THEN + CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,ROFCDF%CVAR(3),ROFCDF%NVARID(3)) ) + ENDIF + ! add water re-infiltration calculation + IF ( LWINFILT ) THEN + CALL NCERROR( NF90_INQ_VARID(ROFCDF%NCID,ROFCDF%CVAR(4),ROFCDF%NVARID(4)) ) + ENDIF + CALL NCERROR( NF90_INQ_DIMID(ROFCDF%NCID,'time',NTIMEID),'GETTING TIME ID FORCING RUNOFF') + CALL NCERROR( NF90_INQUIRE_DIMENSION(NCID=ROFCDF%NCID,DIMID=NTIMEID,LEN=NCDFSTP),'GETTING TIME LENGTH') + + write(LOGNAM,*) "CMF::FORCING_INIT_CDF: CNAME,NCID,VARID", TRIM(ROFCDF%CNAME),ROFCDF%NCID,ROFCDF%NVARID(1) + + !*** 4. check runoff forcing time + IF ( KMINSTART .lt. KMINSTAIN ) THEN + write(LOGNAM,*) "Run start earlier than forcing data", TRIM(ROFCDF%CNAME), KMINSTART, KMINSTAIN + STOP 9 + ENDIF + + KMINENDIN=KMINSTAIN + NCDFSTP*INT(DTIN/60,JPIM) + IF ( KMINEND .gt. KMINENDIN ) THEN + write(LOGNAM,*) "Run end later than forcing data", TRIM(ROFCDF%CNAME), KMINEND, KMINENDIN + STOP 9 + ENDIF + + END SUBROUTINE CMF_FORCING_INIT_CDF #endif !========================================================== !+ @@ -292,476 +292,476 @@ END SUBROUTINE CMF_FORCING_INIT_CDF !+ !========================================================== #ifdef UseCDF_CMF -SUBROUTINE CMF_INPMAT_INIT_CDF -USE YOS_CMF_INPUT, ONLY: NX, NY, INPN, LMAPEND, NXIN,NYIN -USE YOS_CMF_MAP, ONLY: NSEQMAX -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID, NCERROR, mapD2vecD, mapI2vecI -USE NETCDF -IMPLICIT NONE -INTEGER(KIND=JPIM),ALLOCATABLE :: I2TMP(:,:,:) -REAL(KIND=JPRB),ALLOCATABLE :: D2TMP(:,:,:) - -INTEGER(KIND=JPIM) :: INPI -INTEGER(KIND=JPIM) :: VARID -INTEGER(KIND=JPIM) :: ISTATUS,VDIMIDS(1) - -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: IX,IY,ILEV -REAL(KIND=JPRB),SAVE :: ZTMP + SUBROUTINE CMF_INPMAT_INIT_CDF + USE YOS_CMF_INPUT, only: NX, NY, INPN, LMAPEND, NXIN,NYIN + USE YOS_CMF_MAP, only: NSEQMAX + USE CMF_UTILS_MOD, only: INQUIRE_FID, NCERROR, mapD2vecD, mapI2vecI + USE NETCDF + IMPLICIT NONE + integer(KIND=JPIM),ALLOCATABLE :: I2TMP(:,:,:) + real(KIND=JPRB),ALLOCATABLE :: D2TMP(:,:,:) + + integer(KIND=JPIM) :: INPI + integer(KIND=JPIM) :: VARID + integer(KIND=JPIM) :: ISTATUS,VDIMIDS(1) + + ! SAVE for OpenMP + integer(KIND=JPIM),SAVE :: IX,IY,ILEV + real(KIND=JPRB),SAVE :: ZTMP !$OMP THREADPRIVATE (IY,ILEV,ZTMP) !================================================ -!*** 1. allocate input matrix variables -WRITE(LOGNAM,*) 'NX, NY, INPN =', NX, NY, INPN -ALLOCATE( INPX(NSEQMAX,INPN),INPY(NSEQMAX,INPN),INPA(NSEQMAX,INPN) ) - -!*** 2. Read Input Matrix -WRITE(LOGNAM,*) 'INPUT MATRIX netCDF', CINPMAT - -CALL NCERROR (NF90_OPEN(CINPMAT,NF90_NOWRITE,NCID),'opening '//TRIM(CINPMAT) ) - -!** input matrix area -ALLOCATE( D2TMP(NX,NY,INPN) ) -WRITE(LOGNAM,*)'INIT_MAP: inpa:',TRIM(CINPMAT) -CALL NCERROR ( NF90_INQ_VARID(NCID,'inpa',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,D2TMP,(/1,1,1/),(/NX,NY,INPN/)),'reading data' ) -DO INPI=1, INPN - CALL mapD2vecD(D2TMP(:,:,INPI:INPI),INPA(:,INPI:INPI)) -END DO -DEALLOCATE( D2TMP ) - -!** input matrix IXIN -ALLOCATE( I2TMP(NX,NY,INPN) ) - -WRITE(LOGNAM,*)'INIT_MAP: inpx:',TRIM(CINPMAT) -CALL NCERROR ( NF90_INQ_VARID(NCID,'inpx',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2TMP,(/1,1,1/),(/NX,NY,INPN/)),'reading data' ) -DO INPI=1, INPN - CALL mapI2vecI(I2TMP(:,:,INPI:INPI),INPX(:,INPI:INPI)) -END DO - -!** input matrix IYIN -WRITE(LOGNAM,*)'INIT_MAP: inpy:',TRIM(CINPMAT) -CALL NCERROR ( NF90_INQ_VARID(NCID,'inpy',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2TMP,(/1,1,1/),(/NX,NY,INPN/)),'reading data' ) -DO INPI=1, INPN - CALL mapI2vecI(I2TMP(:,:,INPI:INPI),INPY(:,INPI:INPI)) -END DO - -DEALLOCATE( I2TMP ) - -!================================================ -!*** Check if inverse information is available (only used in ECMWF/IFS v4.07) -ISTATUS = NF90_INQ_VARID(NCID, 'levI', VARID) -IF ( ISTATUS /= 0 ) THEN - WRITE(LOGNAM,*) "Could not find levI variable in inpmat.nc: inverse interpolation not available" - INPNI=-1 ! Not available -ELSE - !* Find levels dimension - CALL NCERROR( NF90_INQUIRE_VARIABLE(NCID,VARID,dimids=VDIMIDS),'getting levI dimensions ') - CALL NCERROR( NF90_INQUIRE_DIMENSION(NCID,VDIMIDS(1),len=INPNI),'getting time len ') - WRITE(LOGNAM,*) 'Alocating INP*I: NXIN, NYIN, INPNI =', NXIN, NYIN, INPNI - ALLOCATE( INPXI(NXIN,NYIN,INPNI),INPYI(NXIN,NYIN,INPNI),INPAI(NXIN,NYIN,INPNI) ) - - WRITE(LOGNAM,*)'INIT_MAP: inpaI:',TRIM(CINPMAT) - CALL NCERROR ( NF90_INQ_VARID(NCID,'inpaI',VARID),'getting id' ) - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,INPAI,(/1,1,1/),(/NXIN,NYIN,INPNI/)),'reading data' ) - - WRITE(LOGNAM,*)'INIT_MAP: inpx:',TRIM(CINPMAT) - CALL NCERROR ( NF90_INQ_VARID(NCID,'inpxI',VARID),'getting id' ) - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,INPXI,(/1,1,1/),(/NXIN,NYIN,INPNI/)),'reading data' ) - - WRITE(LOGNAM,*)'INIT_MAP: inpy:',TRIM(CINPMAT) - CALL NCERROR ( NF90_INQ_VARID(NCID,'inpyI',VARID),'getting id' ) - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,INPYI,(/1,1,1/),(/NXIN,NYIN,INPNI/)),'reading data' ) - - !! We normalize INPAI here as it is used to interpolate flood fraction (Input Area Inversed) - WRITE(LOGNAM,*) 'INPAI normalization' + !*** 1. allocate input matrix variables + write(LOGNAM,*) 'NX, NY, INPN =', NX, NY, INPN + allocate( INPX(NSEQMAX,INPN),INPY(NSEQMAX,INPN),INPA(NSEQMAX,INPN) ) + + !*** 2. Read Input Matrix + write(LOGNAM,*) 'INPUT MATRIX netCDF', CINPMAT + + CALL NCERROR (NF90_OPEN(CINPMAT,NF90_NOWRITE,NCID),'opening '//TRIM(CINPMAT) ) + + !** input matrix area + allocate( D2TMP(NX,NY,INPN) ) + write(LOGNAM,*)'INIT_MAP: inpa:',TRIM(CINPMAT) + CALL NCERROR ( NF90_INQ_VARID(NCID,'inpa',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,D2TMP,(/1,1,1/),(/NX,NY,INPN/)),'reading data' ) + DO INPI=1, INPN + CALL mapD2vecD(D2TMP(:,:,INPI:INPI),INPA(:,INPI:INPI)) + ENDDO + deallocate( D2TMP ) + + !** input matrix IXIN + allocate( I2TMP(NX,NY,INPN) ) + + write(LOGNAM,*)'INIT_MAP: inpx:',TRIM(CINPMAT) + CALL NCERROR ( NF90_INQ_VARID(NCID,'inpx',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2TMP,(/1,1,1/),(/NX,NY,INPN/)),'reading data' ) + DO INPI=1, INPN + CALL mapI2vecI(I2TMP(:,:,INPI:INPI),INPX(:,INPI:INPI)) + ENDDO + + !** input matrix IYIN + write(LOGNAM,*)'INIT_MAP: inpy:',TRIM(CINPMAT) + CALL NCERROR ( NF90_INQ_VARID(NCID,'inpy',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2TMP,(/1,1,1/),(/NX,NY,INPN/)),'reading data' ) + DO INPI=1, INPN + CALL mapI2vecI(I2TMP(:,:,INPI:INPI),INPY(:,INPI:INPI)) + ENDDO + + deallocate( I2TMP ) + + !================================================ + !*** Check if inverse information is available (only used in ECMWF/IFS v4.07) + ISTATUS = NF90_INQ_VARID(NCID, 'levI', VARID) + IF ( ISTATUS /= 0 ) THEN + write(LOGNAM,*) "Could not find levI variable in inpmat.nc: inverse interpolation not available" + INPNI=-1 ! Not available + ELSE + !* Find levels dimension + CALL NCERROR( NF90_INQUIRE_VARIABLE(NCID,VARID,dimids=VDIMIDS),'getting levI dimensions ') + CALL NCERROR( NF90_INQUIRE_DIMENSION(NCID,VDIMIDS(1),len=INPNI),'getting time len ') + write(LOGNAM,*) 'Alocating INP*I: NXIN, NYIN, INPNI =', NXIN, NYIN, INPNI + allocate( INPXI(NXIN,NYIN,INPNI),INPYI(NXIN,NYIN,INPNI),INPAI(NXIN,NYIN,INPNI) ) + + write(LOGNAM,*)'INIT_MAP: inpaI:',TRIM(CINPMAT) + CALL NCERROR ( NF90_INQ_VARID(NCID,'inpaI',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,INPAI,(/1,1,1/),(/NXIN,NYIN,INPNI/)),'reading data' ) + + write(LOGNAM,*)'INIT_MAP: inpx:',TRIM(CINPMAT) + CALL NCERROR ( NF90_INQ_VARID(NCID,'inpxI',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,INPXI,(/1,1,1/),(/NXIN,NYIN,INPNI/)),'reading data' ) + + write(LOGNAM,*)'INIT_MAP: inpy:',TRIM(CINPMAT) + CALL NCERROR ( NF90_INQ_VARID(NCID,'inpyI',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,INPYI,(/1,1,1/),(/NXIN,NYIN,INPNI/)),'reading data' ) + + !! We normalize INPAI here as it is used to interpolate flood fraction (Input Area Inversed) + write(LOGNAM,*) 'INPAI normalization' !$OMP PARALLEL DO - DO IX=1,NXIN - DO IY=1,NYIN - ZTMP=0._JPRB - DO ILEV=1,INPNI - ZTMP=ZTMP+INPAI(IX,IY,ILEV) - ENDDO - IF (ZTMP > 0._JPRB) THEN - DO ILEV=1,INPNI - INPAI(IX,IY,ILEV) = INPAI(IX,IY,ILEV) / ZTMP - ENDDO - ENDIF - ENDDO - ENDDO + DO IX=1,NXIN + DO IY=1,NYIN + ZTMP=0._JPRB + DO ILEV=1,INPNI + ZTMP=ZTMP+INPAI(IX,IY,ILEV) + ENDDO + IF (ZTMP > 0._JPRB) THEN + DO ILEV=1,INPNI + INPAI(IX,IY,ILEV) = INPAI(IX,IY,ILEV) / ZTMP + ENDDO + ENDIF + ENDDO + ENDDO !$OMP END PARALLEL DO -ENDIF + ENDIF -END SUBROUTINE CMF_INPMAT_INIT_CDF + END SUBROUTINE CMF_INPMAT_INIT_CDF #endif -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CMF_INPMAT_INIT_BIN -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX, NY, INPN -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID, CONV_END, CONV_ENDI, mapR2vecD, mapI2vecI -USE YOS_CMF_MAP, ONLY: NSEQMAX -IMPLICIT NONE -INTEGER(KIND=JPIM) :: INPI -INTEGER(KIND=JPIM),ALLOCATABLE :: I2TMP(:,:) -REAL(KIND=JPRM),ALLOCATABLE :: R2TMP(:,:) -!================================================ -!*** 1. allocate input matrix variables -WRITE(LOGNAM,*) 'NX, NY, INPN =', NX, NY, INPN -ALLOCATE( INPX(NSEQMAX,INPN),INPY(NSEQMAX,INPN),INPA(NSEQMAX,INPN) ) - -!*** 2. Read Input Matrix -WRITE(LOGNAM,*) 'INPUT MATRIX binary', CINPMAT - -ALLOCATE( I2TMP(NX,NY) ) -ALLOCATE( R2TMP(NX,NY) ) - -TMPNAM=INQUIRE_FID() -!OPEN(TMPNAM,FILE=CINPMAT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY*INPN) -!READ(TMPNAM,REC=1) INPX -!READ(TMPNAM,REC=2) INPY -!READ(TMPNAM,REC=3) R2TMP - -OPEN(TMPNAM,FILE=CINPMAT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -DO INPI=1, INPN - READ(TMPNAM,REC= INPI) I2TMP - CALL mapI2vecI(I2TMP,INPX(:,INPI:INPI)) - READ(TMPNAM,REC= INPN+INPI) I2TMP - CALL mapI2vecI(I2TMP,INPY(:,INPI:INPI)) - READ(TMPNAM,REC=2*INPN+INPI) R2TMP - CALL mapR2vecD( R2TMP,INPA(:,INPI:INPI)) -END DO - -CLOSE(TMPNAM) -DEALLOCATE(I2TMP,R2TMP) - -END SUBROUTINE CMF_INPMAT_INIT_BIN -!========================================================== - -END SUBROUTINE CMF_FORCING_INIT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_FORCING_GET(PBUFF) -! read runoff from file -IMPLICIT NONE -REAL(KIND=JPRB),INTENT(INOUT) :: PBUFF(:,:,:) -!================================================ -IF( LINPCDF ) THEN + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CMF_INPMAT_INIT_BIN + USE YOS_CMF_INPUT, only: TMPNAM, NX, NY, INPN + USE CMF_UTILS_MOD, only: INQUIRE_FID, CONV_END, CONV_ENDI, mapR2vecD, mapI2vecI + USE YOS_CMF_MAP, only: NSEQMAX + IMPLICIT NONE + integer(KIND=JPIM) :: INPI + integer(KIND=JPIM),ALLOCATABLE :: I2TMP(:,:) + real(KIND=JPRM),ALLOCATABLE :: R2TMP(:,:) + !================================================ + !*** 1. allocate input matrix variables + write(LOGNAM,*) 'NX, NY, INPN =', NX, NY, INPN + allocate( INPX(NSEQMAX,INPN),INPY(NSEQMAX,INPN),INPA(NSEQMAX,INPN) ) + + !*** 2. Read Input Matrix + write(LOGNAM,*) 'INPUT MATRIX binary', CINPMAT + + allocate( I2TMP(NX,NY) ) + allocate( R2TMP(NX,NY) ) + + TMPNAM=INQUIRE_FID() + !open(TMPNAM,FILE=CINPMAT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY*INPN) + !READ(TMPNAM,REC=1) INPX + !READ(TMPNAM,REC=2) INPY + !READ(TMPNAM,REC=3) R2TMP + + open(TMPNAM,FILE=CINPMAT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + DO INPI=1, INPN + read(TMPNAM,REC= INPI) I2TMP + CALL mapI2vecI(I2TMP,INPX(:,INPI:INPI)) + read(TMPNAM,REC= INPN+INPI) I2TMP + CALL mapI2vecI(I2TMP,INPY(:,INPI:INPI)) + read(TMPNAM,REC=2*INPN+INPI) R2TMP + CALL mapR2vecD( R2TMP,INPA(:,INPI:INPI)) + ENDDO + + close(TMPNAM) + deallocate(I2TMP,R2TMP) + + END SUBROUTINE CMF_INPMAT_INIT_BIN + !========================================================== + + END SUBROUTINE CMF_FORCING_INIT + !#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_FORCING_GET(PBUFF) + ! read runoff from file + IMPLICIT NONE + real(KIND=JPRB),intent(inout) :: PBUFF(:,:,:) + !================================================ + IF( LINPCDF ) THEN #ifdef UseCDF_CMF - CALL CMF_FORCING_GET_CDF(PBUFF(:,:,:)) + CALL CMF_FORCING_GET_CDF(PBUFF(:,:,:)) #endif -ELSE - CALL CMF_FORCING_GET_BIN(PBUFF(:,:,:)) -ENDIF - -CONTAINS -!========================================================== -!+ CMF_FORCING_GET_BIN -!+ CMF_FORCING_GET_CDF -!========================================================== -SUBROUTINE CMF_FORCING_GET_BIN(PBUFF) -USE YOS_CMF_INPUT, ONLY: TMPNAM,NXIN,NYIN,LROSPLIT,DTIN -USE YOS_CMF_TIME, ONLY: IYYYY, IMM, IDD, IHOUR, IMIN -USE CMF_UTILS_MOD, ONLY: CONV_END,INQUIRE_FID -IMPLICIT NONE -REAL(KIND=JPRB),INTENT(OUT) :: PBUFF(:,:,:) -!* Local variables -INTEGER(KIND=JPIM) :: IRECINP -INTEGER(KIND=JPIM) :: ISEC -CHARACTER(LEN=256) :: CIFNAME !! INPUT FILE -CHARACTER(LEN=256) :: CDATE !! -REAL(KIND=JPRM) :: R2TMP(NXIN,NYIN) -!================================================ -!*** 1. calculate IREC for sub-daily runoff -ISEC = IHOUR*60*60+IMIN*60 !! current second in a day -IRECINP = int( ISEC/DTIN ) +1 !! runoff irec (sub-dairy runoff) - -!*** 2. set file name -WRITE(CDATE,'(I4.4,I2.2,I2.2)') IYYYY,IMM,IDD -CIFNAME=TRIM(CROFDIR)//'/'//TRIM(CROFPRE)//TRIM(CDATE)//TRIM(CROFSUF) -WRITE(LOGNAM,*) "CMF::FORCING_GET_BIN:",TRIM(CIFNAME) - -!*** 3. open & read runoff -TMPNAM=INQUIRE_FID() -OPEN(TMPNAM,FILE=CIFNAME,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NXIN*NYIN) -READ(TMPNAM,REC=IRECINP) R2TMP -CLOSE(TMPNAM) -WRITE(LOGNAM,*) "IRECINP:", IRECINP - -!*** 4. copy runoff to PBUSS, endian conversion is needed -IF( LINPEND ) CALL CONV_END(R2TMP,NXIN,NYIN) -PBUFF(:,:,1)=R2TMP(:,:) - -!*** for sub-surface runoff withe LROSPLIT -PBUFF(:,:,2)=0._JPRB !! Plain Binary subsurface runoff to be added later -IF ( LROSPLIT ) THEN - CIFNAME=TRIM(CSUBDIR)//'/'//TRIM(CSUBPRE)//TRIM(CDATE)//TRIM(CSUBSUF) - WRITE(LOGNAM,*) "CMF::FORCING_GET_BIN: (sub-surface)",TRIM(CIFNAME) - - TMPNAM=INQUIRE_FID() - OPEN(TMPNAM,FILE=CIFNAME,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NXIN*NYIN) - READ(TMPNAM,REC=IRECINP) R2TMP - CLOSE(TMPNAM) - WRITE(LOGNAM,*) "IRECINP:", IRECINP - - IF( LINPEND ) CALL CONV_END(R2TMP,NXIN,NYIN) - PBUFF(:,:,2)=R2TMP(:,:) -ENDIF - -END SUBROUTINE CMF_FORCING_GET_BIN -! ================================================ -!+ -!+ -!+ -! ================================================ + ELSE + CALL CMF_FORCING_GET_BIN(PBUFF(:,:,:)) + ENDIF + + CONTAINS + !========================================================== + !+ CMF_FORCING_GET_BIN + !+ CMF_FORCING_GET_CDF + !========================================================== + SUBROUTINE CMF_FORCING_GET_BIN(PBUFF) + USE YOS_CMF_INPUT, only: TMPNAM,NXIN,NYIN,LROSPLIT,DTIN + USE YOS_CMF_TIME, only: IYYYY, IMM, IDD, IHOUR, IMIN + USE CMF_UTILS_MOD, only: CONV_END,INQUIRE_FID + IMPLICIT NONE + real(KIND=JPRB),intent(out) :: PBUFF(:,:,:) + !* Local variables + integer(KIND=JPIM) :: IRECINP + integer(KIND=JPIM) :: ISEC + character(LEN=256) :: CIFNAME !! INPUT FILE + character(LEN=256) :: CDATE !! + real(KIND=JPRM) :: R2TMP(NXIN,NYIN) + !================================================ + !*** 1. calculate IREC for sub-daily runoff + ISEC = IHOUR*60*60+IMIN*60 !! current second in a day + IRECINP = int( ISEC/DTIN ) +1 !! runoff irec (sub-dairy runoff) + + !*** 2. set file name + write(CDATE,'(I4.4,I2.2,I2.2)') IYYYY,IMM,IDD + CIFNAME=TRIM(CROFDIR)//'/'//TRIM(CROFPRE)//TRIM(CDATE)//TRIM(CROFSUF) + write(LOGNAM,*) "CMF::FORCING_GET_BIN:",TRIM(CIFNAME) + + !*** 3. open & read runoff + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CIFNAME,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NXIN*NYIN) + read(TMPNAM,REC=IRECINP) R2TMP + close(TMPNAM) + write(LOGNAM,*) "IRECINP:", IRECINP + + !*** 4. copy runoff to PBUSS, endian conversion is needed + IF( LINPEND ) CALL CONV_END(R2TMP,NXIN,NYIN) + PBUFF(:,:,1)=R2TMP(:,:) + + !*** for sub-surface runoff withe LROSPLIT + PBUFF(:,:,2)=0._JPRB !! Plain Binary subsurface runoff to be added later + IF ( LROSPLIT ) THEN + CIFNAME=TRIM(CSUBDIR)//'/'//TRIM(CSUBPRE)//TRIM(CDATE)//TRIM(CSUBSUF) + write(LOGNAM,*) "CMF::FORCING_GET_BIN: (sub-surface)",TRIM(CIFNAME) + + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CIFNAME,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NXIN*NYIN) + read(TMPNAM,REC=IRECINP) R2TMP + close(TMPNAM) + write(LOGNAM,*) "IRECINP:", IRECINP + + IF( LINPEND ) CALL CONV_END(R2TMP,NXIN,NYIN) + PBUFF(:,:,2)=R2TMP(:,:) + ENDIF + + END SUBROUTINE CMF_FORCING_GET_BIN + ! ================================================ + !+ + !+ + !+ + ! ================================================ #ifdef UseCDF_CMF -SUBROUTINE CMF_FORCING_GET_CDF(PBUFF) -! Read forcing data from netcdf -! -- call from CMF_FORCING_GET -USE YOS_CMF_TIME, ONLY: KMIN, IYYYYMMDD, IHHMM -USE YOS_CMF_INPUT, ONLY: DTIN, NXIN, NYIN -USE CMF_UTILS_MOD, ONLY: NCERROR -USE NETCDF -IMPLICIT NONE -!* Declaration of arguments -REAL(KIND=JPRB),INTENT(OUT) :: PBUFF(:,:,:) -!* Local variables -INTEGER(KIND=JPIM) :: IRECINP -! ================================================ -!*** 1. calculate irec -IRECINP=INT( (KMIN-ROFCDF%NSTART)*60_JPIM,JPIM ) / INT(DTIN,JPIM) + 1 !! (second from netcdf start time) / (input time step) - -!*** 2. read runoff -CALL NCERROR( NF90_GET_VAR(ROFCDF%NCID,ROFCDF%NVARID(1),PBUFF(:,:,1),(/1,1,IRECINP/),(/NXIN,NYIN,1/)),'READING RUNOFF 1 ' ) -IF ( ROFCDF%NVARID(2) .NE. -1 ) THEN - CALL NCERROR( NF90_GET_VAR(ROFCDF%NCID,ROFCDF%NVARID(2),PBUFF(:,:,2),(/1,1,IRECINP/),(/NXIN,NYIN,1/)),'READING RUNOFF 2' ) -ENDIF -WRITE(LOGNAM,*) "CMF::FORCING_GET_CDF: read runoff:",IYYYYMMDD,IHHMM,IRECINP - -END SUBROUTINE CMF_FORCING_GET_CDF + SUBROUTINE CMF_FORCING_GET_CDF(PBUFF) + ! Read forcing data from netcdf + ! -- CALL from CMF_FORCING_GET + USE YOS_CMF_TIME, only: KMIN, IYYYYMMDD, IHHMM + USE YOS_CMF_INPUT, only: DTIN, NXIN, NYIN + USE CMF_UTILS_MOD, only: NCERROR + USE NETCDF + IMPLICIT NONE + !* Declaration of arguments + real(KIND=JPRB),intent(out) :: PBUFF(:,:,:) + !* Local variables + integer(KIND=JPIM) :: IRECINP + ! ================================================ + !*** 1. calculate irec + IRECINP=INT( (KMIN-ROFCDF%NSTART)*60_JPIM,JPIM ) / INT(DTIN,JPIM) + 1 !! (second from netcdf start time) / (input time step) + + !*** 2. read runoff + CALL NCERROR( NF90_GET_VAR(ROFCDF%NCID,ROFCDF%NVARID(1),PBUFF(:,:,1),(/1,1,IRECINP/),(/NXIN,NYIN,1/)),'READING RUNOFF 1 ' ) + IF ( ROFCDF%NVARID(2) .NE. -1 ) THEN + CALL NCERROR( NF90_GET_VAR(ROFCDF%NCID,ROFCDF%NVARID(2),PBUFF(:,:,2),(/1,1,IRECINP/),(/NXIN,NYIN,1/)),'READING RUNOFF 2' ) + ENDIF + write(LOGNAM,*) "CMF::FORCING_GET_CDF: read runoff:",IYYYYMMDD,IHHMM,IRECINP + + END SUBROUTINE CMF_FORCING_GET_CDF #endif ! ================================================ -END SUBROUTINE CMF_FORCING_GET + END SUBROUTINE CMF_FORCING_GET !#################################################################### -!#################################################################### -SUBROUTINE CMF_FORCING_COM(PBUFF) -! interporlate with inpmatI (CaMa grid -> input runoff grid), then send calling Model -! -- called from "Main Program / Coupler" or CMF_DRV_ADVANCE -USE CMF_UTILS_MOD, ONLY: vecD2mapD + !#################################################################### + SUBROUTINE CMF_FORCING_COM(PBUFF) + ! interporlate with inpmatI (CaMa grid -> input runoff grid), then send calling Model + ! -- called from "Main Program / Coupler" or CMF_DRV_ADVANCE + USE CMF_UTILS_MOD, only: vecD2mapD #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_AllReduce_D2MAP + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_D2MAP #endif -USE YOS_CMF_DIAG, ONLY: D2FLDFRC -USE YOS_CMF_INPUT, ONLY: NX,NY -IMPLICIT NONE -! Declaration of arguments -REAL(KIND=JPRB) :: D2MAPTMP(NX,NY) -REAL(KIND=JPRB), INTENT(OUT) :: PBUFF(:,:,:) -!============================ -CALL vecD2mapD(D2FLDFRC,D2MAPTMP) !! MPI node data is gathered by vecP2mapR + USE YOS_CMF_DIAG, only: D2FLDFRC + USE YOS_CMF_INPUT, only: NX,NY + IMPLICIT NONE + ! Declaration of arguments + real(KIND=JPRB) :: D2MAPTMP(NX,NY) + real(KIND=JPRB), intent(out) :: PBUFF(:,:,:) + !============================ + CALL vecD2mapD(D2FLDFRC,D2MAPTMP) !! MPI node data is gathered by vecP2mapR #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_D2MAP(D2MAPTMP) + CALL CMF_MPI_AllReduce_D2MAP(D2MAPTMP) #endif -CALL INTERPI(D2MAPTMP,PBUFF(:,:,1)) !! Inverse interpolation (CaMa grid -> input runoff grid) - -CONTAINS -!========================================================== -!+ INTERTI -!========================================================== -SUBROUTINE INTERPI(PBUFFIN,PBUFFOUT) -! interporlate field using "input matrix inverse: from catchment to other grid" -USE YOS_CMF_INPUT, ONLY: NXIN, NYIN, NX,NY -IMPLICIT NONE -REAL(KIND=JPRB),INTENT(IN) :: PBUFFIN(:,:) !! CaMa-Flood variable on catchment (NX*NY) -REAL(KIND=JPRB),INTENT(OUT) :: PBUFFOUT(:,:) !! output on target grid = input runoff grid (NXIN * NYIN) - -INTEGER(KIND=JPIM) :: IX,IY,INP,IXIN,IYIN - -IF ( INPNI == -1 ) THEN - WRITE(LOGNAM,*) "INPNI==-1, no inverse interpolation possible" - STOP 9 -ENDIF -PBUFFOUT(:,:)=1._JPRB - -DO IXIN=1,NXIN - DO IYIN=1,NYIN - PBUFFOUT(IXIN,IYIN)=0._JPRB - DO INP=1,INPNI - IX=INPXI(IXIN,IYIN,INP) - IY=INPYI(IXIN,IYIN,INP) - IF ( IX > 0 .AND. IY > 0 .AND. IX <= NX .AND. IY <= NY ) THEN - PBUFFOUT(IXIN,IYIN) = PBUFFOUT(IXIN,IYIN) + PBUFFIN(IX,IY) * INPAI(IXIN,IYIN,INP) - ENDIF - ENDDO - ENDDO -ENDDO - - - -END SUBROUTINE INTERPI -!========================================================== - -END SUBROUTINE CMF_FORCING_COM -!#################################################################### - - -!#################################################################### -SUBROUTINE CMF_FORCING_PUT(PBUFF) -! interporlate with inpmat, then send runoff data to CaMa-Flood -! -- called from "Main Program / Coupler" or CMF_DRV_ADVANCE -! add water re-infiltration calculation -USE YOS_CMF_INPUT, ONLY: LROSPLIT,LWEVAP,LWINFILT -USE YOS_CMF_PROG, ONLY: D2RUNOFF,D2ROFSUB,D2WEVAP,D2WINFILT -IMPLICIT NONE -! Declaration of arguments -REAL(KIND=JPRB), INTENT(IN) :: PBUFF(:,:,:) -!============================ -! Runoff interpolation & unit conversion (mm/dt -> m3/sec) -IF (LINTERP) THEN ! mass conservation using "input matrix table (inpmat)" - CALL ROFF_INTERP(PBUFF(:,:,1),D2RUNOFF) - IF (LROSPLIT) THEN - CALL ROFF_INTERP(PBUFF(:,:,2),D2ROFSUB) - ELSE - D2ROFSUB(:,:) = 0._JPRB - ENDIF - IF (LWEVAP) THEN - CALL ROFF_INTERP(PBUFF(:,:,3),D2WEVAP) - ENDIF - ! add water re-infiltration calculation - IF (LWINFILT) THEN - CALL ROFF_INTERP(PBUFF(:,:,4),D2WINFILT) - ENDIF -ELSE ! nearest point - CALL CONV_RESOL(PBUFF(:,:,1),D2RUNOFF) - IF (LROSPLIT) THEN - CALL CONV_RESOL(PBUFF(:,:,2),D2ROFSUB) - ELSE - D2ROFSUB(:,:) = 0._JPRB - ENDIF - IF (LWEVAP) THEN - CALL CONV_RESOL(PBUFF(:,:,3),D2WEVAP) - ENDIF -! add water re-infiltration calculation - IF (LWINFILT) THEN - CALL CONV_RESOL(PBUFF(:,:,4),D2WINFILT) - ENDIF -ENDIF - -CONTAINS -!========================================================== -!+ ROFF_INTERP : runoff interpolation with mass conservation using "input matrix table (inpmat)" -!+ CONV_RESOL : nearest point runoff interpolation -!========================================================== -SUBROUTINE ROFF_INTERP(PBUFFIN,PBUFFOUT) -! interporlate runoff using "input matrix" -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_INPUT, ONLY: NXIN, NYIN, INPN, RMIS -IMPLICIT NONE -REAL(KIND=JPRB),INTENT(IN) :: PBUFFIN(:,:) !! default [mm/dt] -REAL(KIND=JPRB),INTENT(OUT) :: PBUFFOUT(:,:) !! m3/s -! SAVE for OMP -INTEGER(KIND=JPIM),SAVE :: ISEQ -INTEGER(KIND=JPIM),SAVE :: IXIN, IYIN, INPI !! FOR OUTPUT + CALL INTERPI(D2MAPTMP,PBUFF(:,:,1)) !! Inverse interpolation (CaMa grid -> input runoff grid) + + CONTAINS + !========================================================== + !+ INTERTI + !========================================================== + SUBROUTINE INTERPI(PBUFFIN,PBUFFOUT) + ! interporlate field using "input matrix inverse: from catchment to other grid" + USE YOS_CMF_INPUT, only: NXIN, NYIN, NX,NY + IMPLICIT NONE + real(KIND=JPRB),intent(in) :: PBUFFIN(:,:) !! CaMa-Flood variable on catchment (NX*NY) + real(KIND=JPRB),intent(out) :: PBUFFOUT(:,:) !! output on target grid = input runoff grid (NXIN * NYIN) + + integer(KIND=JPIM) :: IX,IY,INP,IXIN,IYIN + + IF ( INPNI == -1 ) THEN + write(LOGNAM,*) "INPNI==-1, no inverse interpolation possible" + STOP 9 + ENDIF + PBUFFOUT(:,:)=1._JPRB + + DO IXIN=1,NXIN + DO IYIN=1,NYIN + PBUFFOUT(IXIN,IYIN)=0._JPRB + DO INP=1,INPNI + IX=INPXI(IXIN,IYIN,INP) + IY=INPYI(IXIN,IYIN,INP) + IF ( IX > 0 .and. IY > 0 .and. IX <= NX .and. IY <= NY ) THEN + PBUFFOUT(IXIN,IYIN) = PBUFFOUT(IXIN,IYIN) + PBUFFIN(IX,IY) * INPAI(IXIN,IYIN,INP) + ENDIF + ENDDO + ENDDO + ENDDO + + + + END SUBROUTINE INTERPI + !========================================================== + + END SUBROUTINE CMF_FORCING_COM + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_FORCING_PUT(PBUFF) + ! interporlate with inpmat, then send runoff data to CaMa-Flood + ! -- called from "Main Program / Coupler" or CMF_DRV_ADVANCE + ! add water re-infiltration calculation + USE YOS_CMF_INPUT, only: LROSPLIT,LWEVAP,LWINFILT + USE YOS_CMF_PROG, only: D2RUNOFF,D2ROFSUB,D2WEVAP,D2WINFILT + IMPLICIT NONE + ! Declaration of arguments + real(KIND=JPRB), intent(in) :: PBUFF(:,:,:) + !============================ + ! Runoff interpolation & unit conversion (mm/dt -> m3/sec) + IF (LINTERP) THEN ! mass conservation using "input matrix table (inpmat)" + CALL ROFF_INTERP(PBUFF(:,:,1),D2RUNOFF) + IF (LROSPLIT) THEN + CALL ROFF_INTERP(PBUFF(:,:,2),D2ROFSUB) + ELSE + D2ROFSUB(:,:) = 0._JPRB + ENDIF + IF (LWEVAP) THEN + CALL ROFF_INTERP(PBUFF(:,:,3),D2WEVAP) + ENDIF + ! add water re-infiltration calculation + IF (LWINFILT) THEN + CALL ROFF_INTERP(PBUFF(:,:,4),D2WINFILT) + ENDIF + ELSE ! nearest point + CALL CONV_RESOL(PBUFF(:,:,1),D2RUNOFF) + IF (LROSPLIT) THEN + CALL CONV_RESOL(PBUFF(:,:,2),D2ROFSUB) + ELSE + D2ROFSUB(:,:) = 0._JPRB + ENDIF + IF (LWEVAP) THEN + CALL CONV_RESOL(PBUFF(:,:,3),D2WEVAP) + ENDIF + ! add water re-infiltration calculation + IF (LWINFILT) THEN + CALL CONV_RESOL(PBUFF(:,:,4),D2WINFILT) + ENDIF + ENDIF + + CONTAINS + !========================================================== + !+ ROFF_INTERP : runoff interpolation with mass conservation using "input matrix table (inpmat)" + !+ CONV_RESOL : nearest point runoff interpolation + !========================================================== + SUBROUTINE ROFF_INTERP(PBUFFIN,PBUFFOUT) + ! interporlate runoff using "input matrix" + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_INPUT, only: NXIN, NYIN, INPN, RMIS + IMPLICIT NONE + real(KIND=JPRB),intent(in) :: PBUFFIN(:,:) !! default [mm/dt] + real(KIND=JPRB),intent(out) :: PBUFFOUT(:,:) !! m3/s + ! SAVE for OMP + integer(KIND=JPIM),SAVE :: ISEQ + integer(KIND=JPIM),SAVE :: IXIN, IYIN, INPI !! FOR OUTPUT !$OMP THREADPRIVATE (IXIN, IYIN, INPI) !============================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - PBUFFOUT(ISEQ,1)=0._JPRB - DO INPI=1, INPN - IXIN=INPX(ISEQ,INPI) - IYIN=INPY(ISEQ,INPI) - IF( IXIN>0 )THEN - IF( IXIN > NXIN .OR. IYIN > NYIN ) THEN - WRITE(LOGNAM,*) "error" - WRITE(LOGNAM,*) 'XXX',ISEQ,INPI,IXIN,IYIN - CYCLE - ENDIF - IF( PBUFFIN(IXIN,IYIN).NE.RMIS )THEN - PBUFFOUT(ISEQ,1) = PBUFFOUT(ISEQ,1) + PBUFFIN(IXIN,IYIN) * INPA(ISEQ,INPI) / DROFUNIT !! DTIN removed in v395 - ENDIF - ENDIF - END DO - PBUFFOUT(ISEQ,1)=MAX(PBUFFOUT(ISEQ,1), 0._JPRB) -END DO + DO ISEQ=1, NSEQALL + PBUFFOUT(ISEQ,1)=0._JPRB + DO INPI=1, INPN + IXIN=INPX(ISEQ,INPI) + IYIN=INPY(ISEQ,INPI) + IF( IXIN>0 )THEN + IF( IXIN > NXIN .or. IYIN > NYIN ) THEN + write(LOGNAM,*) "error" + write(LOGNAM,*) 'XXX',ISEQ,INPI,IXIN,IYIN + CYCLE + ENDIF + IF( PBUFFIN(IXIN,IYIN).NE.RMIS )THEN + PBUFFOUT(ISEQ,1) = PBUFFOUT(ISEQ,1) + PBUFFIN(IXIN,IYIN) * INPA(ISEQ,INPI) / DROFUNIT !! DTIN removed in v395 + ENDIF + ENDIF + ENDDO + PBUFFOUT(ISEQ,1)=MAX(PBUFFOUT(ISEQ,1), 0._JPRB) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE ROFF_INTERP -!========================================================== -!+ -!+ -!========================================================== -SUBROUTINE CONV_RESOL(PBUFFIN,PBUFFOUT) -!! use runoff data without any interporlation. map resolution & runoff resolution should be same -USE YOS_CMF_MAP, ONLY: NSEQALL, NSEQMAX, D2GRAREA -USE YOS_CMF_INPUT, ONLY: RMIS -USE CMF_UTILS_MOD, ONLY: mapD2vecD -IMPLICIT NONE - -REAL(KIND=JPRB),INTENT(IN) :: PBUFFIN(:,:) !! default [mm/dt] -REAL(KIND=JPRB),INTENT(OUT) :: PBUFFOUT(:,:) !! m3/s - -REAL(KIND=JPRB),ALLOCATABLE :: D2TEMP(:,:) - -INTEGER(KIND=JPIM),SAVE :: ISEQ -! ================================================ -ALLOCATE(D2TEMP(NSEQMAX,1)) -CALL mapD2vecD(PBUFFIN,D2TEMP) + END SUBROUTINE ROFF_INTERP + !========================================================== + !+ + !+ + !========================================================== + SUBROUTINE CONV_RESOL(PBUFFIN,PBUFFOUT) + !! use runoff data without any interporlation. map resolution & runoff resolution should be same + USE YOS_CMF_MAP, only: NSEQALL, NSEQMAX, D2GRAREA + USE YOS_CMF_INPUT, only: RMIS + USE CMF_UTILS_MOD, only: mapD2vecD + IMPLICIT NONE + + real(KIND=JPRB),intent(in) :: PBUFFIN(:,:) !! default [mm/dt] + real(KIND=JPRB),intent(out) :: PBUFFOUT(:,:) !! m3/s + + real(KIND=JPRB),ALLOCATABLE :: D2TEMP(:,:) + + integer(KIND=JPIM),SAVE :: ISEQ + ! ================================================ + allocate(D2TEMP(NSEQMAX,1)) + CALL mapD2vecD(PBUFFIN,D2TEMP) !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - IF( D2TEMP(ISEQ,1).NE.RMIS )THEN - PBUFFOUT(ISEQ,1) = D2TEMP(ISEQ,1) * D2GRAREA(ISEQ,1) / DROFUNIT - PBUFFOUT(ISEQ,1) = MAX(PBUFFOUT(ISEQ,1), 0._JPRB) - ELSE - PBUFFOUT(ISEQ,1)=0._JPRB - ENDIF -END DO + DO ISEQ=1, NSEQALL + IF( D2TEMP(ISEQ,1).NE.RMIS )THEN + PBUFFOUT(ISEQ,1) = D2TEMP(ISEQ,1) * D2GRAREA(ISEQ,1) / DROFUNIT + PBUFFOUT(ISEQ,1) = MAX(PBUFFOUT(ISEQ,1), 0._JPRB) + ELSE + PBUFFOUT(ISEQ,1)=0._JPRB + ENDIF + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CONV_RESOL -!========================================================== + END SUBROUTINE CONV_RESOL + !========================================================== -END SUBROUTINE CMF_FORCING_PUT -!#################################################################### + END SUBROUTINE CMF_FORCING_PUT + !#################################################################### -!#################################################################### -SUBROUTINE CMF_FORCING_END + !#################################################################### + SUBROUTINE CMF_FORCING_END #ifdef UseCDF_CMF -USE CMF_UTILS_MOD, ONLY: NCERROR -USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR + USE NETCDF #endif -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) "CMF::FORCING_END: Finalize forcing module" - -!* Close Input netcdf -IF( LINPCDF ) THEN + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) "CMF::FORCING_END: Finalize forcing module" + + !* Close Input netcdf + IF( LINPCDF ) THEN #ifdef UseCDF_CMF - CALL NCERROR( NF90_CLOSE(ROFCDF%NCID)) - WRITE(LOGNAM,*) "input netCDF runoff closed:",ROFCDF%NCID + CALL NCERROR( NF90_CLOSE(ROFCDF%NCID)) + write(LOGNAM,*) "input netCDF runoff closed:",ROFCDF%NCID #endif -ENDIF + ENDIF -WRITE(LOGNAM,*) "CMF::FORCING_END: end" + write(LOGNAM,*) "CMF::FORCING_END: end" -END SUBROUTINE CMF_FORCING_END -!#################################################################### + END SUBROUTINE CMF_FORCING_END + !#################################################################### END MODULE CMF_CTRL_FORCING_MOD diff --git a/CaMa/src/cmf_ctrl_levee_mod.F90 b/CaMa/src/cmf_ctrl_levee_mod.F90 index 79c73731..d9104e91 100755 --- a/CaMa/src/cmf_ctrl_levee_mod.F90 +++ b/CaMa/src/cmf_ctrl_levee_mod.F90 @@ -10,38 +10,38 @@ MODULE CMF_CTRL_LEVEE_MOD ! -- CMF_CALC_FLDSTG_LEV : Calculate flood stage considering levee ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. -!========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM, JPRD -USE YOS_CMF_INPUT, ONLY: LOGNAM, IMIS -!============================ -IMPLICIT NONE -SAVE -!*** NAMELIST/NLEVEE/ -!*** Levee Map -CHARACTER(LEN=256) :: CLEVHGT !! LEVEE HEIGHT from RIVER -CHARACTER(LEN=256) :: CLEVFRC !! Unprotected fraction. Relative Levee distance from RIVER - -NAMELIST/NLEVEE/ CLEVHGT, CLEVFRC - -!*** Levee Parameters from map -REAL(KIND=JPRB),ALLOCATABLE :: D2LEVHGT(:,:) !! LEVEE HEIGHT [M] (levee croen elevation above elevtn.bin-river elevation) -REAL(KIND=JPRB),ALLOCATABLE :: D2LEVFRC(:,:) !! Unprotected fraction = RELATIVE DISTANCE between LEVEE and RIVER [0-1]. - !! 0 = just aside channel, 1 = edge of catchment - -!*** Levee stage parameter (calculated) -REAL(KIND=JPRB),ALLOCATABLE :: D2BASHGT(:,:) !! LEVEE Base height [M] (levee base elevation above elevtn.bin-river elev) -REAL(KIND=JPRB),ALLOCATABLE :: D2LEVDST(:,:) !! Absolute DISTANCE between LEVEE and RIVER [0-1]. - !! 0 = just aside channel, 1 = edge of catchment - -REAL(KIND=JPRB),ALLOCATABLE :: D2LEVBASSTO(:,:) !! MAXIMUM STORAGE under LEVEE BASE [M3] -REAL(KIND=JPRB),ALLOCATABLE :: D2LEVTOPSTO(:,:) !! MAXIMUM STORAGE at LEVEE TOP [M3] (only river side) -REAL(KIND=JPRB),ALLOCATABLE :: D2LEVFILSTO(:,:) !! MAXIMUM STORAGE at LEVEE TOP [M3] (both river & protected side are filled) + !========================================================== + USE PARKIND1, only: JPIM, JPRB, JPRM, JPRD + USE YOS_CMF_INPUT, only: LOGNAM, IMIS + !============================ + IMPLICIT NONE + SAVE + !*** NAMELIST/NLEVEE/ + !*** Levee Map + character(LEN=256) :: CLEVHGT !! LEVEE HEIGHT from RIVER + character(LEN=256) :: CLEVFRC !! Unprotected fraction. Relative Levee distance from RIVER + + NAMELIST/NLEVEE/ CLEVHGT, CLEVFRC + + !*** Levee Parameters from map + real(KIND=JPRB),ALLOCATABLE :: D2LEVHGT(:,:) !! LEVEE HEIGHT [M] (levee croen elevation above elevtn.bin-river elevation) + real(KIND=JPRB),ALLOCATABLE :: D2LEVFRC(:,:) !! Unprotected fraction = RELATIVE DISTANCE between LEVEE and RIVER [0-1]. + !! 0 = just aside channel, 1 = edge of catchment + + !*** Levee stage parameter (calculated) + real(KIND=JPRB),ALLOCATABLE :: D2BASHGT(:,:) !! LEVEE Base height [M] (levee base elevation above elevtn.bin-river elev) + real(KIND=JPRB),ALLOCATABLE :: D2LEVDST(:,:) !! Absolute DISTANCE between LEVEE and RIVER [0-1]. + !! 0 = just aside channel, 1 = edge of catchment + + real(KIND=JPRB),ALLOCATABLE :: D2LEVBASSTO(:,:) !! MAXIMUM STORAGE under LEVEE BASE [M3] + real(KIND=JPRB),ALLOCATABLE :: D2LEVTOPSTO(:,:) !! MAXIMUM STORAGE at LEVEE TOP [M3] (only river side) + real(KIND=JPRB),ALLOCATABLE :: D2LEVFILSTO(:,:) !! MAXIMUM STORAGE at LEVEE TOP [M3] (both river & protected side are filled) CONTAINS !#################################################################### @@ -51,38 +51,38 @@ MODULE CMF_CTRL_LEVEE_MOD ! -- CMF_LEVEE_FLDSTG : Calculate inflow and outflow at dam ! -- CMF_LEVEE_OPT_PTHOUT : Bifurcation scheme with levee consideration !#################################################################### -SUBROUTINE CMF_LEVEE_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 1. open namelist -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::LEVEE_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE - -!*** 2. default value -CLEVHGT ="NONE" -CLEVFRC ="NONE" - -!*** 3. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NLEVEE) - -WRITE(LOGNAM,*) "=== NAMELIST, NLEVEE ===" -WRITE(LOGNAM,*) "CLEVHGT : ", CLEVHGT -WRITE(LOGNAM,*) "CLEVFRC : ", CLEVFRC - -CLOSE(NSETFILE) - -WRITE(LOGNAM,*) "CMF::LEVEE_NMLIST: end" - -END SUBROUTINE CMF_LEVEE_NMLIST + SUBROUTINE CMF_LEVEE_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 1. open namelist + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::LEVEE_NMLIST: namelist open in unit: ", TRIM(CSETFILE), NSETFILE + + !*** 2. default value + CLEVHGT ="NONE" + CLEVFRC ="NONE" + + !*** 3. read namelist + REWIND(NSETFILE) + READ(NSETFILE,NML=NLEVEE) + + write(LOGNAM,*) "=== NAMELIST, NLEVEE ===" + write(LOGNAM,*) "CLEVHGT : ", CLEVHGT + write(LOGNAM,*) "CLEVFRC : ", CLEVFRC + + close(NSETFILE) + + write(LOGNAM,*) "CMF::LEVEE_NMLIST: end" + + END SUBROUTINE CMF_LEVEE_NMLIST !#################################################################### @@ -90,388 +90,388 @@ END SUBROUTINE CMF_LEVEE_NMLIST !#################################################################### -SUBROUTINE CMF_LEVEE_INIT -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX, NY, NLFP -USE YOS_CMF_MAP, ONLY: NSEQALL, NSEQMAX -USE YOS_CMF_MAP, ONLY: D2GRAREA, D2RIVLEN, D2RIVWTH, D2FLDHGT, & - & D2FLDGRD, D2RIVSTOMAX, D2FLDSTOMAX, DFRCINC -USE CMF_UTILS_MOD, ONLY: mapR2vecD, INQUIRE_FID -! -IMPLICIT NONE -!* local variables -REAL(KIND=JPRM) :: R2TEMP(NX,NY) -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ, I, ILEV -REAL(KIND=JPRB),SAVE :: DSTONOW,DSTOPRE,DHGTPRE,DWTHINC,DWTHPRE,DWTHNOW,DHGTNOW,DHGTDIF + SUBROUTINE CMF_LEVEE_INIT + USE YOS_CMF_INPUT, only: TMPNAM, NX, NY, NLFP + USE YOS_CMF_MAP, only: NSEQALL, NSEQMAX + USE YOS_CMF_MAP, only: D2GRAREA, D2RIVLEN, D2RIVWTH, D2FLDHGT, & + & D2FLDGRD, D2RIVSTOMAX, D2FLDSTOMAX, DFRCINC + USE CMF_UTILS_MOD, only: mapR2vecD, INQUIRE_FID + ! + IMPLICIT NONE + !* local variables + real(KIND=JPRM) :: R2TEMP(NX,NY) + ! SAVE for OpenMP + integer(KIND=JPIM),SAVE :: ISEQ, I, ILEV + real(KIND=JPRB),SAVE :: DSTONOW,DSTOPRE,DHGTPRE,DWTHINC,DWTHPRE,DWTHNOW,DHGTNOW,DHGTDIF !$OMP THREADPRIVATE (I,ILEV,DSTONOW,DSTOPRE,DHGTPRE,DWTHINC,DWTHPRE,DWTHNOW,DHGTNOW,DHGTDIF) -!#################################################################### -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) "CMF::LEVEE_INIT: initialize levee" + !#################################################################### + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) "CMF::LEVEE_INIT: initialize levee" -!******************** -! [1] Read Levee Parameter Map -WRITE(LOGNAM,*) "CMF::LEVEE_INIT: read levee parameter files" + !******************** + ! [1] Read Levee Parameter Map + write(LOGNAM,*) "CMF::LEVEE_INIT: read levee parameter files" -ALLOCATE( D2LEVHGT(NSEQMAX,1) ) -ALLOCATE( D2LEVFRC(NSEQMAX,1) ) -D2LEVHGT(:,:) =0._JPRB -D2LEVFRC(:,:) =0._JPRB + allocate( D2LEVHGT(NSEQMAX,1) ) + allocate( D2LEVFRC(NSEQMAX,1) ) + D2LEVHGT(:,:) =0._JPRB + D2LEVFRC(:,:) =0._JPRB -TMPNAM=INQUIRE_FID() + TMPNAM=INQUIRE_FID() -WRITE(LOGNAM,*)'INIT_LEVEE: levee crown height : ',TRIM(CLEVHGT) -OPEN(TMPNAM,FILE=CLEVHGT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) -CALL mapR2vecD(R2TEMP,D2LEVHGT) -CLOSE(TMPNAM) + write(LOGNAM,*)'INIT_LEVEE: levee crown height : ',TRIM(CLEVHGT) + open(TMPNAM,FILE=CLEVHGT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + CALL mapR2vecD(R2TEMP,D2LEVHGT) + close(TMPNAM) -WRITE(LOGNAM,*)'INIT_LEVEE: distance from levee to river : ',TRIM(CLEVFRC) -OPEN(TMPNAM,FILE=CLEVFRC,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) -CALL mapR2vecD(R2TEMP,D2LEVFRC) -CLOSE(TMPNAM) + write(LOGNAM,*)'INIT_LEVEE: distance from levee to river : ',TRIM(CLEVFRC) + open(TMPNAM,FILE=CLEVFRC,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + CALL mapR2vecD(R2TEMP,D2LEVFRC) + close(TMPNAM) -!******************************* -! [2] Calculate Levee Stage Parameter -WRITE(LOGNAM,*) "CMF::LEVEE_INIT: flood stage parameters considering levee" + !******************************* + ! [2] Calculate Levee Stage Parameter + write(LOGNAM,*) "CMF::LEVEE_INIT: flood stage parameters considering levee" -ALLOCATE( D2BASHGT(NSEQMAX,1) ) -ALLOCATE( D2LEVDST(NSEQMAX,1) ) + allocate( D2BASHGT(NSEQMAX,1) ) + allocate( D2LEVDST(NSEQMAX,1) ) -ALLOCATE( D2LEVBASSTO(NSEQMAX,1) ) -ALLOCATE( D2LEVTOPSTO(NSEQMAX,1) ) -ALLOCATE( D2LEVFILSTO(NSEQMAX,1) ) + allocate( D2LEVBASSTO(NSEQMAX,1) ) + allocate( D2LEVTOPSTO(NSEQMAX,1) ) + allocate( D2LEVFILSTO(NSEQMAX,1) ) -D2FLDSTOMAX(:,:,:) = 0._JPRB !! max floodplain storage at each layer -D2FLDGRD(:,:,:) = 0._JPRB !! floodplain topo gradient of each layer -DFRCINC=dble(NLFP)**(-1.) !! fration of each layer + D2FLDSTOMAX(:,:,:) = 0._JPRB !! max floodplain storage at each layer + D2FLDGRD(:,:,:) = 0._JPRB !! floodplain topo gradient of each layer + DFRCINC=dble(NLFP)**(-1.) !! fration of each layer -D2LEVBASSTO(:,:)= 0._JPRB !! storage at levee base (levee protection start) -D2LEVTOPSTO(:,:)= 0._JPRB !! storage at levee top (levee protection end) -D2LEVFILSTO(:,:)= 0._JPRB !! storage when levee filled (protected-side depth reach levee top) + D2LEVBASSTO(:,:)= 0._JPRB !! storage at levee base (levee protection start) + D2LEVTOPSTO(:,:)= 0._JPRB !! storage at levee top (levee protection end) + D2LEVFILSTO(:,:)= 0._JPRB !! storage when levee filled (protected-side depth reach levee top) !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - IF( D2LEVHGT(ISEQ,1)<=0._JPRB )THEN - D2LEVHGT(ISEQ,1)=0._JPRB - D2LEVFRC(ISEQ,1)=1._JPRB !! If no levee, all area is unprotected/ - ENDIF - D2LEVFRC(ISEQ,1)=MAX(0._JPRB,MIN(1._JPRB,D2LEVFRC(ISEQ,1))) -END DO + DO ISEQ=1, NSEQALL + IF( D2LEVHGT(ISEQ,1)<=0._JPRB )THEN + D2LEVHGT(ISEQ,1)=0._JPRB + D2LEVFRC(ISEQ,1)=1._JPRB !! If no levee, all area is unprotected/ + ENDIF + D2LEVFRC(ISEQ,1)=MAX(0._JPRB,MIN(1._JPRB,D2LEVFRC(ISEQ,1))) + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL -! calculate floodplain parameters (without levee, same as SET_FLDSTG) - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DHGTPRE = 0._JPRB - DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC !! width increlment for each layer - DO I=1, NLFP - DSTONOW = D2RIVLEN(ISEQ,1) * ( D2RIVWTH(ISEQ,1) + DWTHINC*(DBLE(I)-0.5) ) * (D2FLDHGT(ISEQ,1,I)-DHGTPRE) !! storage increment - D2FLDSTOMAX(ISEQ,1,I) = DSTOPRE + DSTONOW - D2FLDGRD(ISEQ,1,I) = (D2FLDHGT(ISEQ,1,I)-DHGTPRE) * DWTHINC**(-1.) - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) - DHGTPRE = D2FLDHGT(ISEQ,1,I) - END DO - -! Levee parameters calculation - IF( D2LEVHGT(ISEQ,1) == 0._JPRB )THEN ! Grid without levee, treat everything as unprotected - D2BASHGT(ISEQ,1) = 1.E18 - D2LEVDST(ISEQ,1) = 1.E18 - D2LEVBASSTO(ISEQ,1) = 1.E18 - D2LEVTOPSTO(ISEQ,1) = 1.E18 - D2LEVFILSTO(ISEQ,1) = 1.E18 - ELSE !! levee exist - !!********* - !! [1] levee base storage & levee top storage (water only in river side) - - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DHGTPRE = 0._JPRB - DWTHPRE = 0._JPRB - D2LEVDST(ISEQ,1) = D2LEVFRC(ISEQ,1) * DWTHINC*NLFP !! distance from channel to levee [m] - - ILEV=INT( D2LEVFRC(ISEQ,1)*NLFP )+1 !! which layer levee exist - IF( ILEV>=2 )THEN - DSTOPRE = D2FLDSTOMAX(ISEQ,1,ILEV-1) - DHGTPRE = D2FLDHGT(ISEQ,1,ILEV-1) - DWTHPRE = DWTHINC * (ILEV-1) - ENDIF - - IF( ILEV<=NLFP )THEN - !! levee in floodplain layer ILEV - DWTHNOW = D2LEVDST(ISEQ,1) - DWTHPRE - DHGTNOW = DWTHNOW * D2FLDGRD(ISEQ,1,ILEV) !! levee height above lower floodplain profile point - D2BASHGT(ISEQ,1) = DHGTNOW + DHGTPRE - D2LEVHGT(ISEQ,1) = max( D2LEVHGT(ISEQ,1), D2BASHGT(ISEQ,1) ) !! levee height >= base height - - DSTONOW = ( DWTHNOW*0.5 + DWTHPRE + D2RIVWTH(ISEQ,1) ) * DHGTNOW * D2RIVLEN(ISEQ,1) - D2LEVBASSTO(ISEQ,1) = DSTOPRE + DSTONOW - - DHGTDIF = D2LEVHGT(ISEQ,1) - D2BASHGT(ISEQ,1) - D2LEVTOPSTO(ISEQ,1) = D2LEVBASSTO(ISEQ,1) + ( D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1) ) * DHGTDIF * D2RIVLEN(ISEQ,1) - ELSE - !! levee on the floodplain edge (ILEV=NLEV+1) - D2BASHGT(ISEQ,1) = DHGTPRE - D2LEVHGT(ISEQ,1) = max( D2LEVHGT(ISEQ,1), D2BASHGT(ISEQ,1) ) !! levee height >= base height - - D2LEVBASSTO(ISEQ,1) = DSTOPRE - - DHGTDIF = D2LEVHGT(ISEQ,1) - D2BASHGT(ISEQ,1) - D2LEVTOPSTO(ISEQ,1) = D2LEVBASSTO(ISEQ,1) + ( D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1) ) * DHGTDIF * D2RIVLEN(ISEQ,1) - ENDIF - - !!********* - !! [2] levee fill storage (water in both river side & protected side) - I=1 - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DWTHPRE = D2RIVWTH(ISEQ,1) - DHGTPRE = 0._JPRB - - !! check which layer levee top belongs - DO WHILE( D2LEVHGT(ISEQ,1) > D2FLDHGT(ISEQ,1,I) .AND. I<=NLFP ) - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) - DWTHPRE = DWTHPRE + DWTHINC - DHGTPRE = D2FLDHGT(ISEQ,1,I) - I=I+1 - IF( I>NLFP ) EXIT - END DO - - !! calculate levee fill volume - IF( I<=NLFP )THEN - !! levee top height collesponds to layer I - DHGTNOW = D2LEVHGT(ISEQ,1) - DHGTPRE - DWTHNOW = DHGTNOW * D2FLDGRD(ISEQ,1,I)**(-1.) - - DSTONOW = ( DWTHNOW*0.5 + DWTHPRE ) * DHGTNOW * D2RIVLEN(ISEQ,1) - D2LEVFILSTO(ISEQ,1) = DSTOPRE + DSTONOW - ELSE - !! levee higher than catchment boundary height - DHGTNOW = D2LEVHGT(ISEQ,1) - DHGTPRE - DSTONOW = DWTHPRE * DHGTNOW * D2RIVLEN(ISEQ,1) - D2LEVFILSTO(ISEQ,1) = DSTOPRE + DSTONOW - ENDIF - ENDIF - -END DO + DO ISEQ=1, NSEQALL + ! calculate floodplain parameters (without levee, same as SET_FLDSTG) + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DHGTPRE = 0._JPRB + DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC !! width increlment for each layer + DO I=1, NLFP + DSTONOW = D2RIVLEN(ISEQ,1) * ( D2RIVWTH(ISEQ,1) + DWTHINC*(DBLE(I)-0.5) ) * (D2FLDHGT(ISEQ,1,I)-DHGTPRE) !! storage increment + D2FLDSTOMAX(ISEQ,1,I) = DSTOPRE + DSTONOW + D2FLDGRD(ISEQ,1,I) = (D2FLDHGT(ISEQ,1,I)-DHGTPRE) * DWTHINC**(-1.) + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DHGTPRE = D2FLDHGT(ISEQ,1,I) + ENDDO + + ! Levee parameters calculation + IF( D2LEVHGT(ISEQ,1) == 0._JPRB )THEN ! Grid without levee, treat everything as unprotected + D2BASHGT(ISEQ,1) = 1.E18 + D2LEVDST(ISEQ,1) = 1.E18 + D2LEVBASSTO(ISEQ,1) = 1.E18 + D2LEVTOPSTO(ISEQ,1) = 1.E18 + D2LEVFILSTO(ISEQ,1) = 1.E18 + ELSE !! levee exist + !!********* + !! [1] levee base storage & levee top storage (water only in river side) + + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DHGTPRE = 0._JPRB + DWTHPRE = 0._JPRB + D2LEVDST(ISEQ,1) = D2LEVFRC(ISEQ,1) * DWTHINC*NLFP !! distance from channel to levee [m] + + ILEV=INT( D2LEVFRC(ISEQ,1)*NLFP )+1 !! which layer levee exist + IF( ILEV>=2 )THEN + DSTOPRE = D2FLDSTOMAX(ISEQ,1,ILEV-1) + DHGTPRE = D2FLDHGT(ISEQ,1,ILEV-1) + DWTHPRE = DWTHINC * (ILEV-1) + ENDIF + + IF( ILEV<=NLFP )THEN + !! levee in floodplain layer ILEV + DWTHNOW = D2LEVDST(ISEQ,1) - DWTHPRE + DHGTNOW = DWTHNOW * D2FLDGRD(ISEQ,1,ILEV) !! levee height above lower floodplain profile point + D2BASHGT(ISEQ,1) = DHGTNOW + DHGTPRE + D2LEVHGT(ISEQ,1) = max( D2LEVHGT(ISEQ,1), D2BASHGT(ISEQ,1) ) !! levee height >= base height + + DSTONOW = ( DWTHNOW*0.5 + DWTHPRE + D2RIVWTH(ISEQ,1) ) * DHGTNOW * D2RIVLEN(ISEQ,1) + D2LEVBASSTO(ISEQ,1) = DSTOPRE + DSTONOW + + DHGTDIF = D2LEVHGT(ISEQ,1) - D2BASHGT(ISEQ,1) + D2LEVTOPSTO(ISEQ,1) = D2LEVBASSTO(ISEQ,1) + ( D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1) ) * DHGTDIF * D2RIVLEN(ISEQ,1) + ELSE + !! levee on the floodplain edge (ILEV=NLEV+1) + D2BASHGT(ISEQ,1) = DHGTPRE + D2LEVHGT(ISEQ,1) = max( D2LEVHGT(ISEQ,1), D2BASHGT(ISEQ,1) ) !! levee height >= base height + + D2LEVBASSTO(ISEQ,1) = DSTOPRE + + DHGTDIF = D2LEVHGT(ISEQ,1) - D2BASHGT(ISEQ,1) + D2LEVTOPSTO(ISEQ,1) = D2LEVBASSTO(ISEQ,1) + ( D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1) ) * DHGTDIF * D2RIVLEN(ISEQ,1) + ENDIF + + !!********* + !! [2] levee fill storage (water in both river side & protected side) + I=1 + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DWTHPRE = D2RIVWTH(ISEQ,1) + DHGTPRE = 0._JPRB + + !! check which layer levee top belongs + DO WHILE( D2LEVHGT(ISEQ,1) > D2FLDHGT(ISEQ,1,I) .and. I<=NLFP ) + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DWTHPRE = DWTHPRE + DWTHINC + DHGTPRE = D2FLDHGT(ISEQ,1,I) + I=I+1 + IF( I>NLFP ) EXIT + ENDDO + + !! calculate levee fill volume + IF( I<=NLFP )THEN + !! levee top height collesponds to layer I + DHGTNOW = D2LEVHGT(ISEQ,1) - DHGTPRE + DWTHNOW = DHGTNOW * D2FLDGRD(ISEQ,1,I)**(-1.) + + DSTONOW = ( DWTHNOW*0.5 + DWTHPRE ) * DHGTNOW * D2RIVLEN(ISEQ,1) + D2LEVFILSTO(ISEQ,1) = DSTOPRE + DSTONOW + ELSE + !! levee higher than catchment boundary height + DHGTNOW = D2LEVHGT(ISEQ,1) - DHGTPRE + DSTONOW = DWTHPRE * DHGTNOW * D2RIVLEN(ISEQ,1) + D2LEVFILSTO(ISEQ,1) = DSTOPRE + DSTONOW + ENDIF + ENDIF + + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CMF_LEVEE_INIT + END SUBROUTINE CMF_LEVEE_INIT !#################################################################### -!#################################################################### -SUBROUTINE CMF_LEVEE_FLDSTG -! ================================================ -! calculate river and floodplain staging considering levee -! ================================================ -USE YOS_CMF_INPUT ,ONLY: NLFP -USE YOS_CMF_MAP ,ONLY: NSEQALL -USE YOS_CMF_MAP ,ONLY: D2GRAREA, D2RIVLEN, D2RIVWTH, D2RIVELV, D2RIVSTOMAX, D2FLDSTOMAX, D2FLDGRD, DFRCINC, D2FLDHGT -USE YOS_CMF_PROG ,ONLY: P2RIVSTO, P2FLDSTO -USE YOS_CMF_DIAG ,ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV -USE YOS_CMF_DIAG ,ONLY: P0GLBSTOPRE2, P0GLBSTONEW2, P0GLBRIVSTO, P0GLBFLDSTO, P0GLBLEVSTO, P0GLBFLDARE - -!! levee specific data -USE YOS_CMF_PROG ,ONLY: P2LEVSTO !! flood storage in protected side (P2FLDSTO for storage betwen river & levee) -USE YOS_CMF_DIAG ,ONLY: D2LEVDPH !! flood depth in protected side (D2FLDDPH for water depth betwen river & levee) -IMPLICIT NONE - -!*** LOCAL -! Save for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ, I, ILEV -REAL(KIND=JPRD),SAVE :: DSTOALL, DSTONOW, DSTOPRE, DWTHNOW, DWTHPRE, DDPHPRE, DDPHNOW, DWTHINC, DSTOADD + !#################################################################### + SUBROUTINE CMF_LEVEE_FLDSTG + ! ================================================ + ! calculate river and floodplain staging considering levee + ! ================================================ + USE YOS_CMF_INPUT ,only: NLFP + USE YOS_CMF_MAP ,only: NSEQALL + USE YOS_CMF_MAP ,only: D2GRAREA, D2RIVLEN, D2RIVWTH, D2RIVELV, D2RIVSTOMAX, D2FLDSTOMAX, D2FLDGRD, DFRCINC, D2FLDHGT + USE YOS_CMF_PROG ,only: P2RIVSTO, P2FLDSTO + USE YOS_CMF_DIAG ,only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV + USE YOS_CMF_DIAG ,only: P0GLBSTOPRE2, P0GLBSTONEW2, P0GLBRIVSTO, P0GLBFLDSTO, P0GLBLEVSTO, P0GLBFLDARE + + !! levee specific data + USE YOS_CMF_PROG ,only: P2LEVSTO !! flood storage in protected side (P2FLDSTO for storage betwen river & levee) + USE YOS_CMF_DIAG ,only: D2LEVDPH !! flood depth in protected side (D2FLDDPH for water depth betwen river & levee) + IMPLICIT NONE + + !*** LOCAL + ! Save for OpenMP + integer(KIND=JPIM),SAVE :: ISEQ, I, ILEV + real(KIND=JPRD),SAVE :: DSTOALL, DSTONOW, DSTOPRE, DWTHNOW, DWTHPRE, DDPHPRE, DDPHNOW, DWTHINC, DSTOADD !$OMP THREADPRIVATE (I,ILEV,DSTOALL, DSTONOW, DSTOPRE, DWTHNOW, DWTHPRE, DDPHPRE, DDPHNOW, DWTHINC, DSTOADD) -!!============================== -P0GLBSTOPRE2=0._JPRD -P0GLBSTONEW2=0._JPRD -P0GLBRIVSTO =0._JPRD -P0GLBFLDSTO =0._JPRD -P0GLBLEVSTO =0._JPRD -P0GLBFLDARE =0._JPRD + !!============================== + P0GLBSTOPRE2=0._JPRD + P0GLBSTONEW2=0._JPRD + P0GLBRIVSTO =0._JPRD + P0GLBFLDSTO =0._JPRD + P0GLBLEVSTO =0._JPRD + P0GLBFLDARE =0._JPRD !$OMP PARALLEL DO REDUCTION(+:P0GLBSTOPRE2,P0GLBSTONEW2,P0GLBRIVSTO,P0GLBFLDSTO,P0GLBLEVSTO,P0GLBFLDARE) -DO ISEQ=1, NSEQALL -! - DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P2LEVSTO(ISEQ,1) - DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC !! width of each layer [m] - IF( DSTOALL > D2RIVSTOMAX(ISEQ,1) )THEN - !********** - ! [Case-1] Water surface is under levee base (all water is between river-levee) - IF( DSTOALL < D2LEVBASSTO(ISEQ,1) )THEN - I=1 - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DWTHPRE = D2RIVWTH(ISEQ,1) - DDPHPRE = 0._JPRB - - ! which layer current water level is - DO WHILE( DSTOALL > D2FLDSTOMAX(ISEQ,1,I) .AND. I<=NLFP ) - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) - DWTHPRE = DWTHPRE + DWTHINC - DDPHPRE = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHINC - I=I+1 - IF( I>NLFP ) EXIT - END DO - - ! water depth at unprotected area - IF( I<=NLFP )THEN - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = -DWTHPRE + ( DWTHPRE**2. + 2. * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 - D2FLDDPH(ISEQ,1) = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHNOW - ELSE - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = 0._JPRB - D2FLDDPH(ISEQ,1) = DDPHPRE + DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) - ENDIF - - P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) - D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) -! - P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) - D2FLDFRC(ISEQ,1) = (-D2RIVWTH(ISEQ,1) + DWTHPRE + DWTHNOW ) * (DWTHINC*NLFP)**(-1.) - D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB ) - D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB ) - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) -! - P2LEVSTO(ISEQ,1) = 0._JPRD !! no flooding in protected area - D2LEVDPH(ISEQ,1) = 0._JPRB - - !********** - ! [Case-2] River-side water surface is under levee crown (water only in river side) - ELSEIF( DSTOALL < D2LEVTOPSTO(ISEQ,1) )THEN - - DSTONOW = DSTOALL - D2LEVBASSTO(ISEQ,1) - DWTHNOW = D2LEVDST(ISEQ,1) + D2RIVWTH(ISEQ,1) - D2FLDDPH(ISEQ,1) = D2BASHGT(ISEQ,1) + DSTONOW * DWTHNOW**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) - - P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) - D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) - ! - P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) - D2FLDFRC(ISEQ,1) = D2LEVFRC(ISEQ,1) - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) - ! - P2LEVSTO(ISEQ,1) = 0._JPRD !! no flooding in protected area - D2LEVDPH(ISEQ,1) = 0._JPRB - - !********** - ! [Case-3] River side is full, protected side is under levee crown height (Water both in river side & protected side) - ELSEIF( DSTOALL < D2LEVFILSTO(ISEQ,1) )THEN - ! river side stage = levee height - D2FLDDPH(ISEQ,1) = D2LEVHGT(ISEQ,1) - P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) - D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) - - P2FLDSTO(ISEQ,1) = D2LEVTOPSTO(ISEQ,1) - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) - - !! protected side storate calculation - P2LEVSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) - P2LEVSTO(ISEQ,1) = MAX( P2LEVSTO(ISEQ,1), 0._JPRD ) - - !!**** - !! protected side stage calculation - ILEV=INT( D2LEVFRC(ISEQ,1)*NLFP )+1 !! levee relative distance -> floodplain layer with levee - DSTOPRE = D2LEVTOPSTO(ISEQ,1) - DWTHPRE = 0._JPRB - DDPHPRE = 0._JPRB - !! which layer current water level is - I=ILEV - DO WHILE( I<=NLFP ) - DSTOADD = ( D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1) ) * ( D2LEVHGT(ISEQ,1)-D2FLDHGT(ISEQ,1,I) ) * D2RIVLEN(ISEQ,1) - IF( DSTOALL < D2FLDSTOMAX(ISEQ,1,I) + DSTOADD ) EXIT - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DSTOADD - DWTHPRE = DWTHINC*I - D2LEVDST(ISEQ,1) - DDPHPRE = D2FLDHGT(ISEQ,1,I) - D2BASHGT(ISEQ,1) - I=I+1 - IF( I>NLFP ) EXIT - END DO - - IF( I<=NLFP )THEN - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = -DWTHPRE + ( DWTHPRE**2. + 2. * DSTONOW*D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 - DDPHNOW = DWTHNOW * D2FLDGRD(ISEQ,1,I) - D2LEVDPH(ISEQ,1) = D2BASHGT(ISEQ,1) + DDPHPRE + DDPHNOW - - D2FLDFRC(ISEQ,1) = ( DWTHPRE + D2LEVDST(ISEQ,1) ) * (DWTHINC*NLFP)**(-1.) - D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB) - D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB) - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) - ELSE - DSTONOW = DSTOALL - DSTOPRE - DDPHNOW = DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) - D2LEVDPH(ISEQ,1) = D2BASHGT(ISEQ,1) + DDPHPRE + DDPHNOW - - D2FLDFRC(ISEQ,1) = 1._JPRB - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) - ENDIF - - !********** - ! [Case-4] Water level above levee crown (Both river side and protected side exceed levee crown height) - ELSE - I=1 - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DWTHPRE = D2RIVWTH(ISEQ,1) - DDPHPRE = 0._JPRB - DO WHILE( DSTOALL > D2FLDSTOMAX(ISEQ,1,I) .AND. I<=NLFP) - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) - DWTHPRE = DWTHPRE + DWTHINC - DDPHPRE = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHINC - I=I+1 - IF( I>NLFP ) EXIT - END DO - - IF( I<=NLFP )THEN - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = -DWTHPRE + ( DWTHPRE**2. + 2. * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 - D2FLDDPH(ISEQ,1) = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHNOW - ELSE - DSTONOW = DSTOALL - DSTOPRE - DWTHNOW = 0._JPRB - D2FLDDPH(ISEQ,1) = DDPHPRE + DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) - ENDIF - - D2FLDFRC(ISEQ,1) = (-D2RIVWTH(ISEQ,1) + DWTHPRE + DWTHNOW ) * (DWTHINC*NLFP)**(-1.) - D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) - - !! river channel storage - P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) - D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) -! - DSTOADD = ( D2FLDDPH(ISEQ,1)-D2LEVHGT(ISEQ,1) ) * (D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1)) * D2RIVLEN(ISEQ,1) - P2FLDSTO(ISEQ,1) = D2LEVTOPSTO(ISEQ,1) + DSTOADD - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) - - P2LEVSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) - P2LEVSTO(ISEQ,1) = MAX( P2LEVSTO(ISEQ,1), 0._JPRD ) - D2LEVDPH(ISEQ,1) = D2FLDDPH(ISEQ,1) - ENDIF - - ! [Case-0] Water only in river channel - ELSE - P2RIVSTO(ISEQ,1) = DSTOALL - D2RIVDPH(ISEQ,1) = DSTOALL * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) - D2RIVDPH(ISEQ,1) = MAX( D2RIVDPH(ISEQ,1), 0._JPRB ) - P2FLDSTO(ISEQ,1) = 0._JPRD - D2FLDDPH(ISEQ,1) = 0._JPRB - D2FLDFRC(ISEQ,1) = 0._JPRB - D2FLDARE(ISEQ,1) = 0._JPRB - P2LEVSTO(ISEQ,1) = 0._JPRD - D2LEVDPH(ISEQ,1) = 0._JPRB - ENDIF - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) - - P0GLBSTOPRE2 = P0GLBSTOPRE2 + DSTOALL - P0GLBSTONEW2 = P0GLBSTONEW2 + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P2LEVSTO(ISEQ,1) - P0GLBRIVSTO = P0GLBRIVSTO + P2RIVSTO(ISEQ,1) - P0GLBFLDSTO = P0GLBFLDSTO + P2FLDSTO(ISEQ,1) - P0GLBLEVSTO = P0GLBLEVSTO + P2LEVSTO(ISEQ,1) - P0GLBFLDARE = P0GLBFLDARE + D2FLDARE(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL + + DSTOALL = P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P2LEVSTO(ISEQ,1) + DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC !! width of each layer [m] + IF( DSTOALL > D2RIVSTOMAX(ISEQ,1) )THEN + !********** + ! [Case-1] Water surface is under levee base (all water is between river-levee) + IF( DSTOALL < D2LEVBASSTO(ISEQ,1) )THEN + I=1 + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DWTHPRE = D2RIVWTH(ISEQ,1) + DDPHPRE = 0._JPRB + + ! which layer current water level is + DO WHILE( DSTOALL > D2FLDSTOMAX(ISEQ,1,I) .and. I<=NLFP ) + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DWTHPRE = DWTHPRE + DWTHINC + DDPHPRE = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHINC + I=I+1 + IF( I>NLFP ) EXIT + ENDDO + + ! water depth at unprotected area + IF( I<=NLFP )THEN + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = -DWTHPRE + ( DWTHPRE**2. + 2. * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 + D2FLDDPH(ISEQ,1) = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHNOW + ELSE + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = 0._JPRB + D2FLDDPH(ISEQ,1) = DDPHPRE + DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) + ENDIF + + P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) + D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + + P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) + D2FLDFRC(ISEQ,1) = (-D2RIVWTH(ISEQ,1) + DWTHPRE + DWTHNOW ) * (DWTHINC*NLFP)**(-1.) + D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB ) + D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB ) + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + + P2LEVSTO(ISEQ,1) = 0._JPRD !! no flooding in protected area + D2LEVDPH(ISEQ,1) = 0._JPRB + + !********** + ! [Case-2] River-side water surface is under levee crown (water only in river side) + ELSEIF( DSTOALL < D2LEVTOPSTO(ISEQ,1) )THEN + + DSTONOW = DSTOALL - D2LEVBASSTO(ISEQ,1) + DWTHNOW = D2LEVDST(ISEQ,1) + D2RIVWTH(ISEQ,1) + D2FLDDPH(ISEQ,1) = D2BASHGT(ISEQ,1) + DSTONOW * DWTHNOW**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) + + P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) + D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + + P2FLDSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) + D2FLDFRC(ISEQ,1) = D2LEVFRC(ISEQ,1) + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + + P2LEVSTO(ISEQ,1) = 0._JPRD !! no flooding in protected area + D2LEVDPH(ISEQ,1) = 0._JPRB + + !********** + ! [Case-3] River side is full, protected side is under levee crown height (Water both in river side & protected side) + ELSEIF( DSTOALL < D2LEVFILSTO(ISEQ,1) )THEN + ! river side stage = levee height + D2FLDDPH(ISEQ,1) = D2LEVHGT(ISEQ,1) + P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) + D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + + P2FLDSTO(ISEQ,1) = D2LEVTOPSTO(ISEQ,1) - P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) + + !! protected side storate calculation + P2LEVSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) + P2LEVSTO(ISEQ,1) = MAX( P2LEVSTO(ISEQ,1), 0._JPRD ) + + !!**** + !! protected side stage calculation + ILEV=INT( D2LEVFRC(ISEQ,1)*NLFP )+1 !! levee relative distance -> floodplain layer with levee + DSTOPRE = D2LEVTOPSTO(ISEQ,1) + DWTHPRE = 0._JPRB + DDPHPRE = 0._JPRB + !! which layer current water level is + I=ILEV + DO WHILE( I<=NLFP ) + DSTOADD = ( D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1) ) * ( D2LEVHGT(ISEQ,1)-D2FLDHGT(ISEQ,1,I) ) * D2RIVLEN(ISEQ,1) + IF( DSTOALL < D2FLDSTOMAX(ISEQ,1,I) + DSTOADD ) EXIT + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DSTOADD + DWTHPRE = DWTHINC*I - D2LEVDST(ISEQ,1) + DDPHPRE = D2FLDHGT(ISEQ,1,I) - D2BASHGT(ISEQ,1) + I=I+1 + IF( I>NLFP ) EXIT + ENDDO + + IF( I<=NLFP )THEN + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = -DWTHPRE + ( DWTHPRE**2. + 2. * DSTONOW*D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 + DDPHNOW = DWTHNOW * D2FLDGRD(ISEQ,1,I) + D2LEVDPH(ISEQ,1) = D2BASHGT(ISEQ,1) + DDPHPRE + DDPHNOW + + D2FLDFRC(ISEQ,1) = ( DWTHPRE + D2LEVDST(ISEQ,1) ) * (DWTHINC*NLFP)**(-1.) + D2FLDFRC(ISEQ,1) = MAX( D2FLDFRC(ISEQ,1),0._JPRB) + D2FLDFRC(ISEQ,1) = MIN( D2FLDFRC(ISEQ,1),1._JPRB) + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + ELSE + DSTONOW = DSTOALL - DSTOPRE + DDPHNOW = DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) + D2LEVDPH(ISEQ,1) = D2BASHGT(ISEQ,1) + DDPHPRE + DDPHNOW + + D2FLDFRC(ISEQ,1) = 1._JPRB + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + ENDIF + + !********** + ! [Case-4] Water level above levee crown (Both river side and protected side exceed levee crown height) + ELSE + I=1 + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DWTHPRE = D2RIVWTH(ISEQ,1) + DDPHPRE = 0._JPRB + DO WHILE( DSTOALL > D2FLDSTOMAX(ISEQ,1,I) .and. I<=NLFP) + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DWTHPRE = DWTHPRE + DWTHINC + DDPHPRE = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHINC + I=I+1 + IF( I>NLFP ) EXIT + ENDDO + + IF( I<=NLFP )THEN + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = -DWTHPRE + ( DWTHPRE**2. + 2. * DSTONOW * D2RIVLEN(ISEQ,1)**(-1.) * D2FLDGRD(ISEQ,1,I)**(-1.) )**0.5 + D2FLDDPH(ISEQ,1) = DDPHPRE + D2FLDGRD(ISEQ,1,I) * DWTHNOW + ELSE + DSTONOW = DSTOALL - DSTOPRE + DWTHNOW = 0._JPRB + D2FLDDPH(ISEQ,1) = DDPHPRE + DSTONOW * DWTHPRE**(-1.) * D2RIVLEN(ISEQ,1)**(-1.) + ENDIF + + D2FLDFRC(ISEQ,1) = (-D2RIVWTH(ISEQ,1) + DWTHPRE + DWTHNOW ) * (DWTHINC*NLFP)**(-1.) + D2FLDARE(ISEQ,1) = D2GRAREA(ISEQ,1)*D2FLDFRC(ISEQ,1) + + !! river channel storage + P2RIVSTO(ISEQ,1) = D2RIVSTOMAX(ISEQ,1) + D2RIVLEN(ISEQ,1) * D2RIVWTH(ISEQ,1) * D2FLDDPH(ISEQ,1) + D2RIVDPH(ISEQ,1) = P2RIVSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + + DSTOADD = ( D2FLDDPH(ISEQ,1)-D2LEVHGT(ISEQ,1) ) * (D2LEVDST(ISEQ,1)+D2RIVWTH(ISEQ,1)) * D2RIVLEN(ISEQ,1) + P2FLDSTO(ISEQ,1) = D2LEVTOPSTO(ISEQ,1) + DSTOADD - P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) = MAX( P2FLDSTO(ISEQ,1), 0._JPRD ) + + P2LEVSTO(ISEQ,1) = DSTOALL - P2RIVSTO(ISEQ,1) - P2FLDSTO(ISEQ,1) + P2LEVSTO(ISEQ,1) = MAX( P2LEVSTO(ISEQ,1), 0._JPRD ) + D2LEVDPH(ISEQ,1) = D2FLDDPH(ISEQ,1) + ENDIF + + ! [Case-0] Water only in river channel + ELSE + P2RIVSTO(ISEQ,1) = DSTOALL + D2RIVDPH(ISEQ,1) = DSTOALL * D2RIVLEN(ISEQ,1)**(-1.) * D2RIVWTH(ISEQ,1)**(-1.) + D2RIVDPH(ISEQ,1) = MAX( D2RIVDPH(ISEQ,1), 0._JPRB ) + P2FLDSTO(ISEQ,1) = 0._JPRD + D2FLDDPH(ISEQ,1) = 0._JPRB + D2FLDFRC(ISEQ,1) = 0._JPRB + D2FLDARE(ISEQ,1) = 0._JPRB + P2LEVSTO(ISEQ,1) = 0._JPRD + D2LEVDPH(ISEQ,1) = 0._JPRB + ENDIF + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + + P0GLBSTOPRE2 = P0GLBSTOPRE2 + DSTOALL + P0GLBSTONEW2 = P0GLBSTONEW2 + P2RIVSTO(ISEQ,1) + P2FLDSTO(ISEQ,1) + P2LEVSTO(ISEQ,1) + P0GLBRIVSTO = P0GLBRIVSTO + P2RIVSTO(ISEQ,1) + P0GLBFLDSTO = P0GLBFLDSTO + P2FLDSTO(ISEQ,1) + P0GLBLEVSTO = P0GLBLEVSTO + P2LEVSTO(ISEQ,1) + P0GLBFLDARE = P0GLBFLDARE + D2FLDARE(ISEQ,1) + ENDDO !$OMP END PARALLEL DO END SUBROUTINE CMF_LEVEE_FLDSTG @@ -481,178 +481,178 @@ END SUBROUTINE CMF_LEVEE_FLDSTG !#################################################################### -SUBROUTINE CMF_LEVEE_OPT_PTHOUT -! realistic bifurcation considering levee -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: DT, PGRV, DMIS -USE YOS_CMF_MAP, ONLY: NSEQALL, NSEQMAX, NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN, PTH_DST, & - & PTH_ELV, PTH_WTH, PTH_MAN, I2MASK -USE YOS_CMF_MAP, ONLY: D2ELEVTN, D2RIVELV -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, D1PTHFLW, D2RIVOUT, D2FLDOUT -USE YOS_CMF_PROG, ONLY: D1PTHFLW_PRE, D2RIVDPH_PRE -USE YOS_CMF_DIAG, ONLY: D2PTHOUT, D2PTHINF, D2RIVINF, D2LEVDPH, D2FLDINF, D2SFCELV -IMPLICIT NONE -!*** Local -REAL(KIND=JPRB) :: D2SFCELV_LEV(NSEQMAX,1) !! water surface elev protected [m] - -REAL(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elev (t-1) [m] (for stable calculation) -REAL(KIND=JPRB) :: D2RATE(NSEQMAX,1) !! outflow correction - -REAL(KIND=JPRD) :: P2PTHOUT(NSEQMAX,1) !! for SinglePrecision Mode -REAL(KIND=JPRD) :: P2PTHINF(NSEQMAX,1) !! - -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: IPTH, ILEV, ISEQ, ISEQP, JSEQP -REAL(KIND=JPRB),SAVE :: DSLOPE, DFLW, DOUT_PRE, DFLW_PRE, DFLW_IMP, DSTO_TMP + SUBROUTINE CMF_LEVEE_OPT_PTHOUT + ! realistic bifurcation considering levee + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: DT, PGRV, DMIS + USE YOS_CMF_MAP, only: NSEQALL, NSEQMAX, NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN, PTH_DST, & + & PTH_ELV, PTH_WTH, PTH_MAN, I2MASK + USE YOS_CMF_MAP, only: D2ELEVTN, D2RIVELV + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, D1PTHFLW, D2RIVOUT, D2FLDOUT + USE YOS_CMF_PROG, only: D1PTHFLW_PRE, D2RIVDPH_PRE + USE YOS_CMF_DIAG, only: D2PTHOUT, D2PTHINF, D2RIVINF, D2LEVDPH, D2FLDINF, D2SFCELV + IMPLICIT NONE + !*** Local + real(KIND=JPRB) :: D2SFCELV_LEV(NSEQMAX,1) !! water surface elev protected [m] + + real(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elev (t-1) [m] (for stable calculation) + real(KIND=JPRB) :: D2RATE(NSEQMAX,1) !! outflow correction + + real(KIND=JPRD) :: P2PTHOUT(NSEQMAX,1) !! for SinglePrecision Mode + real(KIND=JPRD) :: P2PTHINF(NSEQMAX,1) !! + + ! SAVE for OpenMP + integer(KIND=JPIM),SAVE :: IPTH, ILEV, ISEQ, ISEQP, JSEQP + real(KIND=JPRB),SAVE :: DSLOPE, DFLW, DOUT_PRE, DFLW_PRE, DFLW_IMP, DSTO_TMP !$OMP THREADPRIVATE (DSLOPE, DFLW, DOUT_PRE, DFLW_PRE, DFLW_IMP, DSTO_TMP, ILEV, ISEQP, JSEQP) !================================================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - IF( D2LEVFRC(ISEQ,1)<1.0 )THEN - D2SFCELV_LEV(ISEQ,1) = D2ELEVTN(ISEQ,1)+D2LEVDPH(ISEQ,1) !! levee exist, calculate pthout based on levee protected depth - ELSE - D2SFCELV_LEV(ISEQ,1) = D2SFCELV(ISEQ,1) - ENDIF - - D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1)+D2RIVDPH_PRE(ISEQ,1) - P2PTHOUT(ISEQ,1) = 0._JPRD - P2PTHINF(ISEQ,1) = 0._JPRD - D2RATE(ISEQ,1) =-999._JPRB -END DO + DO ISEQ=1, NSEQALL + IF( D2LEVFRC(ISEQ,1)<1.0 )THEN + D2SFCELV_LEV(ISEQ,1) = D2ELEVTN(ISEQ,1)+D2LEVDPH(ISEQ,1) !! levee exist, calculate pthout based on levee protected depth + ELSE + D2SFCELV_LEV(ISEQ,1) = D2SFCELV(ISEQ,1) + ENDIF + + D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1)+D2RIVDPH_PRE(ISEQ,1) + P2PTHOUT(ISEQ,1) = 0._JPRD + P2PTHINF(ISEQ,1) = 0._JPRD + D2RATE(ISEQ,1) =-999._JPRB + ENDDO !$OMP END PARALLEL DO -D1PTHFLW(:,:) = DMIS + D1PTHFLW(:,:) = DMIS !$OMP PARALLEL DO -DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - !! Avoid calculation outside of domain - IF (ISEQP<=0 .OR. JSEQP<=0 ) CYCLE - IF (I2MASK(ISEQP,1) == 1 .OR. I2MASK(JSEQP,1) == 1 ) CYCLE !! I2MASK is for kinematic-inertial mixed flow scheme. - -!! [1] for channel bifurcation, use river surface elevation - DSLOPE = (D2SFCELV(ISEQP,1)-D2SFCELV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) - DSLOPE = max(-0.005_JPRB,min(0.005_JPRB,DSLOPE)) !! v390 stabilization - - ILEV=1 !! for river channek - DFLW = MAX(D2SFCELV(ISEQP,1),D2SFCELV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) - DFLW = MAX(DFLW,0._JPRB) - - DFLW_PRE = MAX(D2SFCELV_PRE(ISEQP,1),D2SFCELV_PRE(JSEQP,1)) - PTH_ELV(IPTH,ILEV) - DFLW_PRE = MAX(DFLW_PRE,0._JPRB) - - DFLW_IMP = (DFLW*DFLW_PRE)**0.5 !! semi implicit flow depth - IF( DFLW_IMP<=0._JPRB ) DFLW_IMP=DFLW - - IF( DFLW_IMP>1.E-5 )THEN !! local inertial equation, see [Bates et al., 2010, J.Hydrol.] - DOUT_PRE = D1PTHFLW_PRE(IPTH,ILEV) * PTH_WTH(IPTH,ILEV)**(-1.) !! outflow (t-1) [m2/s] (unit width) - D1PTHFLW(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*PTH_MAN(ILEV)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - ELSE - D1PTHFLW(IPTH,ILEV) = 0._JPRB - ENDIF - -!! [1] for overland bifurcation, use levee protected surface elevation - IF( NPTHLEV<=1 ) CYCLE - - DSLOPE = (D2SFCELV_LEV(ISEQP,1)-D2SFCELV_LEV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) - DSLOPE = max(-0.005_JPRB,min(0.005_JPRB,DSLOPE)) - - DO ILEV=2, NPTHLEV - DFLW = MAX(D2SFCELV_LEV(ISEQP,1),D2SFCELV_LEV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) - DFLW = MAX(DFLW,0._JPRB) - - DFLW_IMP=DFLW !! do not consider implicit flow depth for overland bifurcation - IF( DFLW_IMP>1.E-5 )THEN !! local inertial equation, see [Bates et al., 2010, J.Hydrol.] - DOUT_PRE = D1PTHFLW_PRE(IPTH,ILEV) * PTH_WTH(IPTH,ILEV)**(-1.) !! outflow (t-1) [m2/s] (unit width) - D1PTHFLW(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*PTH_MAN(ILEV)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - ELSE - D1PTHFLW(IPTH,ILEV) = 0._JPRB - ENDIF - END DO -END DO + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + !! Avoid calculation outside of domain + IF (ISEQP<=0 .or. JSEQP<=0 ) CYCLE + IF (I2MASK(ISEQP,1) == 1 .or. I2MASK(JSEQP,1) == 1 ) CYCLE !! I2MASK is for kinematic-inertial mixed flow scheme. + + !! [1] for channel bifurcation, use river surface elevation + DSLOPE = (D2SFCELV(ISEQP,1)-D2SFCELV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) + DSLOPE = max(-0.005_JPRB,min(0.005_JPRB,DSLOPE)) !! v390 stabilization + + ILEV=1 !! for river channek + DFLW = MAX(D2SFCELV(ISEQP,1),D2SFCELV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) + DFLW = MAX(DFLW,0._JPRB) + + DFLW_PRE = MAX(D2SFCELV_PRE(ISEQP,1),D2SFCELV_PRE(JSEQP,1)) - PTH_ELV(IPTH,ILEV) + DFLW_PRE = MAX(DFLW_PRE,0._JPRB) + + DFLW_IMP = (DFLW*DFLW_PRE)**0.5 !! semi implicit flow depth + IF( DFLW_IMP<=0._JPRB ) DFLW_IMP=DFLW + + IF( DFLW_IMP>1.E-5 )THEN !! local inertial equation, see [Bates et al., 2010, J.Hydrol.] + DOUT_PRE = D1PTHFLW_PRE(IPTH,ILEV) * PTH_WTH(IPTH,ILEV)**(-1.) !! outflow (t-1) [m2/s] (unit width) + D1PTHFLW(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*PTH_MAN(ILEV)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + ELSE + D1PTHFLW(IPTH,ILEV) = 0._JPRB + ENDIF + + !! [1] for overland bifurcation, use levee protected surface elevation + IF( NPTHLEV<=1 ) CYCLE + + DSLOPE = (D2SFCELV_LEV(ISEQP,1)-D2SFCELV_LEV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) + DSLOPE = max(-0.005_JPRB,min(0.005_JPRB,DSLOPE)) + + DO ILEV=2, NPTHLEV + DFLW = MAX(D2SFCELV_LEV(ISEQP,1),D2SFCELV_LEV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) + DFLW = MAX(DFLW,0._JPRB) + + DFLW_IMP=DFLW !! do not consider implicit flow depth for overland bifurcation + IF( DFLW_IMP>1.E-5 )THEN !! local inertial equation, see [Bates et al., 2010, J.Hydrol.] + DOUT_PRE = D1PTHFLW_PRE(IPTH,ILEV) * PTH_WTH(IPTH,ILEV)**(-1.) !! outflow (t-1) [m2/s] (unit width) + D1PTHFLW(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*PTH_MAN(ILEV)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + ELSE + D1PTHFLW(IPTH,ILEV) = 0._JPRB + ENDIF + ENDDO + ENDDO !$OMP END PARALLEL DO #ifndef NoAtom_CMF !$OMP PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - !! Avoid calculation outside of domain - IF (ISEQP<=0 .OR. JSEQP<=0 ) CYCLE - IF (I2MASK(ISEQP,1) == 1 .OR. I2MASK(JSEQP,1) == 1 ) CYCLE - - DO ILEV=1, NPTHLEV - IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN !! total outflow from each grid + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + !! Avoid calculation outside of domain + IF (ISEQP<=0 .or. JSEQP<=0 ) CYCLE + IF (I2MASK(ISEQP,1) == 1 .or. I2MASK(JSEQP,1) == 1 ) CYCLE + + DO ILEV=1, NPTHLEV + IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN !! total outflow from each grid #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHOUT(ISEQP,1) = P2PTHOUT(ISEQP,1) + D1PTHFLW(IPTH,ILEV) - ELSE + P2PTHOUT(ISEQP,1) = P2PTHOUT(ISEQP,1) + D1PTHFLW(IPTH,ILEV) + ELSE #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHOUT(JSEQP,1) = P2PTHOUT(JSEQP,1) - D1PTHFLW(IPTH,ILEV) - ENDIF - END DO -END DO + P2PTHOUT(JSEQP,1) = P2PTHOUT(JSEQP,1) - D1PTHFLW(IPTH,ILEV) + ENDIF + ENDDO + ENDDO #ifndef NoAtom_CMF !$OMP END PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif !$OMP PARALLEL DO !! calculate total outflow from a grid -DO ISEQ=1, NSEQALL - IF( D2PTHOUT(ISEQ,1) > 1.E-10 )THEN - DSTO_TMP = ( P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) ) & - - D2RIVOUT(ISEQ,1)*DT + D2RIVINF(ISEQ,1)*DT - D2FLDOUT(ISEQ,1)*DT + D2FLDINF(ISEQ,1)*DT - D2RATE(ISEQ,1) = MIN( DSTO_TMP * (D2PTHOUT(ISEQ,1)*DT)**(-1.), 1._JPRB ) - ELSE - D2RATE(ISEQ,1) = 1._JPRB - ENDIF - D2PTHOUT(ISEQ,1) = D2PTHOUT(ISEQ,1) * D2RATE(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL + IF( D2PTHOUT(ISEQ,1) > 1.E-10 )THEN + DSTO_TMP = ( P2RIVSTO(ISEQ,1)+P2FLDSTO(ISEQ,1) ) & + - D2RIVOUT(ISEQ,1)*DT + D2RIVINF(ISEQ,1)*DT - D2FLDOUT(ISEQ,1)*DT + D2FLDINF(ISEQ,1)*DT + D2RATE(ISEQ,1) = MIN( DSTO_TMP * (D2PTHOUT(ISEQ,1)*DT)**(-1.), 1._JPRB ) + ELSE + D2RATE(ISEQ,1) = 1._JPRB + ENDIF + D2PTHOUT(ISEQ,1) = D2PTHOUT(ISEQ,1) * D2RATE(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -D2PTHOUT(:,:)=P2PTHOUT(:,:) + D2PTHOUT(:,:)=P2PTHOUT(:,:) #ifndef NoAtom_CMF !$OMP PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - !! Avoid calculation outside of domain - IF (ISEQP<=0 .OR. JSEQP<=0 ) CYCLE - IF (I2MASK(ISEQP,1) == 1 .OR. I2MASK(JSEQP,1) == 1 ) CYCLE - - DO ILEV=1, NPTHLEV - IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN - D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(ISEQP,1) + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + !! Avoid calculation outside of domain + IF (ISEQP<=0 .or. JSEQP<=0 ) CYCLE + IF (I2MASK(ISEQP,1) == 1 .or. I2MASK(JSEQP,1) == 1 ) CYCLE + + DO ILEV=1, NPTHLEV + IF( D1PTHFLW(IPTH,ILEV) >= 0._JPRB )THEN + D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(ISEQP,1) #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHINF(JSEQP,1) = P2PTHINF(JSEQP,1) + D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) - ELSE - D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(JSEQP,1) + P2PTHINF(JSEQP,1) = P2PTHINF(JSEQP,1) + D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) + ELSE + D1PTHFLW(IPTH,ILEV) = D1PTHFLW(IPTH,ILEV)*D2RATE(JSEQP,1) #ifndef NoAtom_CMF !$OMP ATOMIC #endif - P2PTHINF(ISEQP,1) = P2PTHINF(ISEQP,1) - D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) - ENDIF - D1PTHFLW_PRE(IPTH,ILEV)=D1PTHFLW(IPTH,ILEV) - END DO -END DO + P2PTHINF(ISEQP,1) = P2PTHINF(ISEQP,1) - D1PTHFLW(IPTH,ILEV) !! total inflow [m3/s] (from upstream) + ENDIF + D1PTHFLW_PRE(IPTH,ILEV)=D1PTHFLW(IPTH,ILEV) + ENDDO + ENDDO #ifndef NoAtom_CMF !$OMP END PARALLEL DO !! No OMP Atomic for bit-identical simulation (set in Mkinclude) #endif -D2PTHINF(:,:)=P2PTHINF(:,:) + D2PTHINF(:,:)=P2PTHINF(:,:) -END SUBROUTINE CMF_LEVEE_OPT_PTHOUT + END SUBROUTINE CMF_LEVEE_OPT_PTHOUT !################################################################ END MODULE CMF_CTRL_LEVEE_MOD diff --git a/CaMa/src/cmf_ctrl_maps_mod.F90 b/CaMa/src/cmf_ctrl_maps_mod.F90 index deef8930..ea196d1d 100755 --- a/CaMa/src/cmf_ctrl_maps_mod.F90 +++ b/CaMa/src/cmf_ctrl_maps_mod.F90 @@ -17,38 +17,38 @@ MODULE CMF_CTRL_MAPS_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -! shared variables in module -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM -IMPLICIT NONE -SAVE -!*** NAMELIST/NMAP/ from inputnam -CHARACTER(LEN=256) :: CNEXTXY !! river network nextxy -CHARACTER(LEN=256) :: CGRAREA !! catchment area -CHARACTER(LEN=256) :: CELEVTN !! bank top elevation -CHARACTER(LEN=256) :: CNXTDST !! distance to next outlet -CHARACTER(LEN=256) :: CRIVLEN !! river channel length -CHARACTER(LEN=256) :: CFLDHGT !! floodplain elevation profile -!* river channel parameters -CHARACTER(LEN=256) :: CRIVWTH !! channel width -CHARACTER(LEN=256) :: CRIVHGT !! channel depth -CHARACTER(LEN=256) :: CRIVMAN !! river manning coefficient -!* optional maps -CHARACTER(LEN=256) :: CPTHOUT !! bifurcation channel table -CHARACTER(LEN=256) :: CGDWDLY !! Groundwater Delay Parameter -CHARACTER(LEN=256) :: CMEANSL !! mean sea level -!* MPI parallelization -CHARACTER(LEN=256) :: CMPIREG !! MPI region map -!* netCDF map -LOGICAL :: LMAPCDF !! true for netCDF map input -CHARACTER(LEN=256) :: CRIVCLINC !! river map netcdf -CHARACTER(LEN=256) :: CRIVPARNC !! river parameter netcdf (WIDTH,HEIGHT, Manning, ground wateer delay) -CHARACTER(LEN=256) :: CMEANSLNC !! mean sea level netCDF -CHARACTER(LEN=256) :: CMPIREGNC !! MPI Region netCDF - -NAMELIST/NMAP/ CNEXTXY, CGRAREA, CELEVTN, CNXTDST, CRIVLEN, CFLDHGT, & - CRIVWTH, CRIVHGT, CRIVMAN, CPTHOUT, CGDWDLY, CMEANSL, & - CMPIREG, LMAPCDF, CRIVCLINC,CRIVPARNC,CMEANSLNC,CMPIREGNC + ! shared variables in module + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM + IMPLICIT NONE + SAVE + !*** NAMELIST/NMAP/ from inputnam + character(LEN=256) :: CNEXTXY !! river network nextxy + character(LEN=256) :: CGRAREA !! catchment area + character(LEN=256) :: CELEVTN !! bank top elevation + character(LEN=256) :: CNXTDST !! distance to next outlet + character(LEN=256) :: CRIVLEN !! river channel length + character(LEN=256) :: CFLDHGT !! floodplain elevation profile + !* river channel parameters + character(LEN=256) :: CRIVWTH !! channel width + character(LEN=256) :: CRIVHGT !! channel depth + character(LEN=256) :: CRIVMAN !! river manning coefficient + !* optional maps + character(LEN=256) :: CPTHOUT !! bifurcation channel table + character(LEN=256) :: CGDWDLY !! Groundwater Delay Parameter + character(LEN=256) :: CMEANSL !! mean sea level + !* MPI parallelization + character(LEN=256) :: CMPIREG !! MPI region map + !* netCDF map + logical :: LMAPCDF !! true for netCDF map input + character(LEN=256) :: CRIVCLINC !! river map netcdf + character(LEN=256) :: CRIVPARNC !! river parameter netcdf (WIDTH,HEIGHT, Manning, ground wateer delay) + character(LEN=256) :: CMEANSLNC !! mean sea level netCDF + character(LEN=256) :: CMPIREGNC !! MPI Region netCDF + + NAMELIST/NMAP/ CNEXTXY, CGRAREA, CELEVTN, CNXTDST, CRIVLEN, CFLDHGT, & + CRIVWTH, CRIVHGT, CRIVMAN, CPTHOUT, CGDWDLY, CMEANSL, & + CMPIREG, LMAPCDF, CRIVCLINC,CRIVPARNC,CMEANSLNC,CMPIREGNC CONTAINS @@ -59,89 +59,89 @@ MODULE CMF_CTRL_MAPS_MOD ! ! !#################################################################### -SUBROUTINE CMF_MAPS_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE,LMEANSL,LGDWDLY -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -!*** 1. open namelist -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::MAP_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE - -!*** 2. default value -CNEXTXY="./nextxy.bin" -CGRAREA="./ctmare.bin" -CELEVTN="./elevtn.bin" -CNXTDST="./nxtdst.bin" -CRIVLEN="./rivlen.bin" -CFLDHGT="./fldhgt.bin" - -CRIVWTH="./rivwth.bin" -CRIVHGT="./rivhgt.bin" -CRIVMAN="./rivman.bin" - -CPTHOUT="./bifprm.txt" -CGDWDLY="NONE" -CMEANSL="NONE" - -CMPIREG="NONE" - -LMAPCDF=.FALSE. -CRIVCLINC="NONE" -CRIVPARNC="NONE" -CMEANSLNC="NONE" -CMPIREGNC="NONE" - -!*** 3. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NMAP) - -WRITE(LOGNAM,*) "=== NAMELIST, NMAP ===" -WRITE(LOGNAM,*) "LMAPCDF: ", LMAPCDF -IF( LMAPCDF )THEN - WRITE(LOGNAM,*) "CRIVCLINC: ", TRIM(CRIVCLINC) - WRITE(LOGNAM,*) "CRIVPARNC: ", TRIM(CRIVPARNC) - IF( LMEANSL ) THEN - WRITE(LOGNAM,*) "CMEANSLNC: ", TRIM(CMEANSLNC) - ENDIF + SUBROUTINE CMF_MAPS_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE,LMEANSL,LGDWDLY + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + !*** 1. open namelist + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::MAP_NMLIST: namelist open in unit: ", TRIM(CSETFILE), NSETFILE + + !*** 2. default value + CNEXTXY="./nextxy.bin" + CGRAREA="./ctmare.bin" + CELEVTN="./elevtn.bin" + CNXTDST="./nxtdst.bin" + CRIVLEN="./rivlen.bin" + CFLDHGT="./fldhgt.bin" + + CRIVWTH="./rivwth.bin" + CRIVHGT="./rivhgt.bin" + CRIVMAN="./rivman.bin" + + CPTHOUT="./bifprm.txt" + CGDWDLY="NONE" + CMEANSL="NONE" + + CMPIREG="NONE" + + LMAPCDF=.FALSE. + CRIVCLINC="NONE" + CRIVPARNC="NONE" + CMEANSLNC="NONE" + CMPIREGNC="NONE" + + !*** 3. read namelist + rewind(NSETFILE) + read(NSETFILE,NML=NMAP) + + write(LOGNAM,*) "=== NAMELIST, NMAP ===" + write(LOGNAM,*) "LMAPCDF: ", LMAPCDF + IF( LMAPCDF )THEN + write(LOGNAM,*) "CRIVCLINC: ", TRIM(CRIVCLINC) + write(LOGNAM,*) "CRIVPARNC: ", TRIM(CRIVPARNC) + IF( LMEANSL ) THEN + write(LOGNAM,*) "CMEANSLNC: ", TRIM(CMEANSLNC) + ENDIF #ifdef UseMPI_CMF - WRITE(LOGNAM,*) "CMPIREGNC: ", TRIM(CMPIREGNC) + write(LOGNAM,*) "CMPIREGNC: ", TRIM(CMPIREGNC) #endif -ELSE - WRITE(LOGNAM,*) "CNEXTXY: ", TRIM(CNEXTXY) - WRITE(LOGNAM,*) "CGRAREA: ", TRIM(CGRAREA) - WRITE(LOGNAM,*) "CELEVTN: ", TRIM(CELEVTN) - WRITE(LOGNAM,*) "CNXTDST: ", TRIM(CNXTDST) - WRITE(LOGNAM,*) "CRIVLEN: ", TRIM(CRIVLEN) - WRITE(LOGNAM,*) "CFLDHGT: ", TRIM(CFLDHGT) - - WRITE(LOGNAM,*) "CRIVWTH: ", TRIM(CRIVWTH) - WRITE(LOGNAM,*) "CRIVHGT: ", TRIM(CRIVHGT) - WRITE(LOGNAM,*) "CRIVMAN: ", TRIM(CRIVMAN) - - WRITE(LOGNAM,*) "CPTHOUT: ", TRIM(CPTHOUT) - IF( LGDWDLY )THEN - WRITE(LOGNAM,*) "CGDWDLY: ",TRIM(CGDWDLY) - ENDIF - IF( LMEANSL )THEN - WRITE(LOGNAM,*) "CMEANSL: ", TRIM(CMEANSL) - ENDIF + ELSE + write(LOGNAM,*) "CNEXTXY: ", TRIM(CNEXTXY) + write(LOGNAM,*) "CGRAREA: ", TRIM(CGRAREA) + write(LOGNAM,*) "CELEVTN: ", TRIM(CELEVTN) + write(LOGNAM,*) "CNXTDST: ", TRIM(CNXTDST) + write(LOGNAM,*) "CRIVLEN: ", TRIM(CRIVLEN) + write(LOGNAM,*) "CFLDHGT: ", TRIM(CFLDHGT) + + write(LOGNAM,*) "CRIVWTH: ", TRIM(CRIVWTH) + write(LOGNAM,*) "CRIVHGT: ", TRIM(CRIVHGT) + write(LOGNAM,*) "CRIVMAN: ", TRIM(CRIVMAN) + + write(LOGNAM,*) "CPTHOUT: ", TRIM(CPTHOUT) + IF( LGDWDLY )THEN + write(LOGNAM,*) "CGDWDLY: ",TRIM(CGDWDLY) + ENDIF + IF( LMEANSL )THEN + write(LOGNAM,*) "CMEANSL: ", TRIM(CMEANSL) + ENDIF #ifdef UseMPI_CMF - WRITE(LOGNAM,*) "CMPIREG: ", TRIM(CMPIREG) + write(LOGNAM,*) "CMPIREG: ", TRIM(CMPIREG) #endif -ENDIF + ENDIF -CLOSE(NSETFILE) + close(NSETFILE) -WRITE(LOGNAM,*) "CMF::MAP_NMLIST: end" + write(LOGNAM,*) "CMF::MAP_NMLIST: end" -END SUBROUTINE CMF_MAPS_NMLIST + END SUBROUTINE CMF_MAPS_NMLIST !#################################################################### @@ -149,826 +149,826 @@ END SUBROUTINE CMF_MAPS_NMLIST !#################################################################### -SUBROUTINE CMF_RIVMAP_INIT -! read & set river network map -! -- call from CMF_DRV_INIT -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX,NY,NLFP, LPTHOUT -USE YOS_CMF_MAP, ONLY: I2NEXTX,I2NEXTY, I2REGION, REGIONALL,REGIONTHIS, & - & I1SEQX, I1SEQY, I1NEXT, I2VECTOR, D1LON, D1LAT, & - & NSEQRIV, NSEQALL, NSEQMAX -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) 'CMF::RIVMAP_INIT: river network initialization' - -! *** 1. ALLOCATE ARRAYS -ALLOCATE( I2NEXTX(NX,NY) ) -ALLOCATE( I2NEXTY(NX,NY) ) -ALLOCATE( I2REGION(NX,NY) ) -ALLOCATE( D1LON(NX) ) -ALLOCATE( D1LAT(NY) ) - -!============================ -!*** 2a. read river network map -WRITE(LOGNAM,*) 'CMF::RIVMAP_INIT: read nextXY & set lat lon' -IF( LMAPCDF )THEN + SUBROUTINE CMF_RIVMAP_INIT + ! read & set river network map + ! -- CALL from CMF_DRV_INIT + USE YOS_CMF_INPUT, only: TMPNAM, NX,NY,NLFP, LPTHOUT + USE YOS_CMF_MAP, only: I2NEXTX,I2NEXTY, I2REGION, REGIONALL,REGIONTHIS, & + & I1SEQX, I1SEQY, I1NEXT, I2VECTOR, D1LON, D1LAT, & + & NSEQRIV, NSEQALL, NSEQMAX + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) 'CMF::RIVMAP_INIT: river network initialization' + + ! *** 1. allocate ARRAYS + allocate( I2NEXTX(NX,NY) ) + allocate( I2NEXTY(NX,NY) ) + allocate( I2REGION(NX,NY) ) + allocate( D1LON(NX) ) + allocate( D1LAT(NY) ) + + !============================ + !*** 2a. read river network map + write(LOGNAM,*) 'CMF::RIVMAP_INIT: read nextXY & set lat lon' + IF( LMAPCDF )THEN #ifdef UseCDF_CMF - CALL READ_MAP_CDF + CALL READ_MAP_CDF #endif -ELSE - CALL READ_MAP_BIN -ENDIF - -!*** 2b. calculate river sequence & regions -WRITE(LOGNAM,*) 'CMF::RIVMAP_INIT: calc region' -CALL CALC_REGION - -!============================ -!*** 3. conversion 2D map -> 1D vector -WRITE(LOGNAM,*) 'CMF::RIVMAP_INIT: calculate 1d river sequence' - -CALL CALC_1D_SEQ !! 2D map to 1D vector conversion. for faster calculation - -WRITE(LOGNAM,*) ' NSEQRIV=',NSEQRIV -WRITE(LOGNAM,*) ' NSEQALL=',NSEQALL - -!*** 3c. Write Map Data !! used for combining mpi distributed output into one map -IF( REGIONTHIS==1 )THEN - TMPNAM=INQUIRE_FID() - OPEN(TMPNAM,FILE='./mapdata.txt',FORM='FORMATTED') - WRITE(TMPNAM,*) 'NX', NX - WRITE(TMPNAM,*) 'NY', NY - WRITE(TMPNAM,*) 'NLFP', NLFP - WRITE(TMPNAM,*) 'REGIONALL', REGIONALL - WRITE(TMPNAM,*) 'NSEQMAX', NSEQMAX - CLOSE(TMPNAM) -ENDIF - -!============================ -!*** 4. bifurcation channel parameters -IF( LPTHOUT )THEN - WRITE(LOGNAM,*) 'CMF::RIVMAP_INIT: read bifurcation channel setting' - CALL READ_BIFPARAM -ENDIF - -DEALLOCATE( I2NEXTX,I2NEXTY,I2REGION ) - -WRITE(LOGNAM,*) 'CMF::RIVMAP_INIT: end' + ELSE + CALL READ_MAP_BIN + ENDIF -CONTAINS -!========================================================== -!+ READ_MAP_BIN -!+ READ_MAP_CDF -!+ CALC_REGION -!+ CALC_1D_SEQ -!+ READ_BIFPRM -!========================================================== -SUBROUTINE READ_MAP_BIN -USE YOS_CMF_INPUT, ONLY: TMPNAM, LMAPEND -USE YOS_CMF_INPUT, ONLY: WEST,EAST,NORTH,SOUTH -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID, CONV_ENDI -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM),SAVE :: IX,IY -!========================================================== -!*** read river map -WRITE(LOGNAM,*)'RIVMAP_INIT: nextxy binary: ',TRIM(CNEXTXY) -TMPNAM=INQUIRE_FID() -OPEN(TMPNAM,FILE=CNEXTXY,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) I2NEXTX -READ(TMPNAM,REC=2) I2NEXTY -CLOSE(TMPNAM) - -IF ( LMAPEND )THEN - CALL CONV_ENDI(I2NEXTX,NX,NY) - CALL CONV_ENDI(I2NEXTY,NX,NY) -ENDIF - -!*** calculate lat, lon -IF( WEST>=-180._JPRB .and. EAST<=360._JPRB .and. SOUTH>=-180._JPRB .and. NORTH<=180._JPRB )THEN !! bugfix_v396a - !$OMP PARALLEL DO - DO IX=1,NX - D1LON(IX)=WEST +(DBLE(IX)-0.5D0)*(EAST-WEST) /DBLE(NX) - ENDDO - !$OMP END PARALLEL DO - !$OMP PARALLEL DO - DO IY=1,NY - D1LAT(IY)=NORTH-(DBLE(IY)-0.5D0)*(NORTH-SOUTH)/DBLE(NY) - ENDDO - !$OMP END PARALLEL DO -ENDIF - -END SUBROUTINE READ_MAP_BIN -!========================================================== -!+ -!+ -!+ -!========================================================== + !*** 2b. calculate river sequence & regions + write(LOGNAM,*) 'CMF::RIVMAP_INIT: calc region' + CALL CALC_REGION + + !============================ + !*** 3. conversion 2D map -> 1D vector + write(LOGNAM,*) 'CMF::RIVMAP_INIT: calculate 1d river sequence' + + CALL CALC_1D_SEQ !! 2D map to 1D vector conversion. for faster calculation + + write(LOGNAM,*) ' NSEQRIV=',NSEQRIV + write(LOGNAM,*) ' NSEQALL=',NSEQALL + + !*** 3c. Write Map Data !! used for combining mpi distributed output into one map + IF( REGIONTHIS==1 )THEN + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE='./mapdata.txt',FORM='FORMATTED') + write(TMPNAM,*) 'NX', NX + write(TMPNAM,*) 'NY', NY + write(TMPNAM,*) 'NLFP', NLFP + write(TMPNAM,*) 'REGIONALL', REGIONALL + write(TMPNAM,*) 'NSEQMAX', NSEQMAX + close(TMPNAM) + ENDIF + + !============================ + !*** 4. bifurcation channel parameters + IF( LPTHOUT )THEN + write(LOGNAM,*) 'CMF::RIVMAP_INIT: read bifurcation channel setting' + CALL READ_BIFPARAM + ENDIF + + deallocate( I2NEXTX,I2NEXTY,I2REGION ) + + write(LOGNAM,*) 'CMF::RIVMAP_INIT: end' + + CONTAINS + !========================================================== + !+ READ_MAP_BIN + !+ READ_MAP_CDF + !+ CALC_REGION + !+ CALC_1D_SEQ + !+ READ_BIFPRM + !========================================================== + SUBROUTINE READ_MAP_BIN + USE YOS_CMF_INPUT, only: TMPNAM, LMAPEND + USE YOS_CMF_INPUT, only: WEST,EAST,NORTH,SOUTH + USE CMF_UTILS_MOD, only: INQUIRE_FID, CONV_ENDI + IMPLICIT NONE + !* local variables + integer(KIND=JPIM),SAVE :: IX,IY + !========================================================== + !*** read river map + write(LOGNAM,*)'RIVMAP_INIT: nextxy binary: ',TRIM(CNEXTXY) + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CNEXTXY,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) I2NEXTX + read(TMPNAM,REC=2) I2NEXTY + close(TMPNAM) + + IF ( LMAPEND )THEN + CALL CONV_ENDI(I2NEXTX,NX,NY) + CALL CONV_ENDI(I2NEXTY,NX,NY) + ENDIF + + !*** calculate lat, lon + IF( WEST>=-180._JPRB .and. EAST<=360._JPRB .and. SOUTH>=-180._JPRB .and. NORTH<=180._JPRB )THEN !! bugfix_v396a + !$OMP PARALLEL DO + DO IX=1,NX + D1LON(IX)=WEST +(DBLE(IX)-0.5D0)*(EAST-WEST) /DBLE(NX) + ENDDO + !$OMP END PARALLEL DO + !$OMP PARALLEL DO + DO IY=1,NY + D1LAT(IY)=NORTH-(DBLE(IY)-0.5D0)*(NORTH-SOUTH)/DBLE(NY) + ENDDO + !$OMP END PARALLEL DO + ENDIF + + END SUBROUTINE READ_MAP_BIN + !========================================================== + !+ + !+ + !+ + !========================================================== #ifdef UseCDF_CMF -SUBROUTINE READ_MAP_CDF -USE CMF_UTILS_MOD ,ONLY: NCERROR -USE NETCDF -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM) :: NCID,VARID -!================================================ -WRITE(LOGNAM,*)'RIVMAP_INIT: nextxy netCDF: ', TRIM(CRIVCLINC) + SUBROUTINE READ_MAP_CDF + USE CMF_UTILS_MOD ,only: NCERROR + USE NETCDF + IMPLICIT NONE + !* local variables + integer(KIND=JPIM) :: NCID,VARID + !================================================ + write(LOGNAM,*)'RIVMAP_INIT: nextxy netCDF: ', TRIM(CRIVCLINC) -CALL NCERROR (NF90_OPEN(CRIVCLINC,NF90_NOWRITE,NCID),'opening '//TRIM(CRIVCLINC) ) + CALL NCERROR (NF90_OPEN(CRIVCLINC,NF90_NOWRITE,NCID),'opening '//TRIM(CRIVCLINC) ) -!*** next xy -CALL NCERROR ( NF90_INQ_VARID(NCID,'nextx',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2NEXTX),'reading data' ) + !*** next xy + CALL NCERROR ( NF90_INQ_VARID(NCID,'nextx',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2NEXTX),'reading data' ) -CALL NCERROR ( NF90_INQ_VARID(NCID,'nexty',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2NEXTY),'reading data' ) + CALL NCERROR ( NF90_INQ_VARID(NCID,'nexty',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2NEXTY),'reading data' ) -!*** lat, lon -CALL NCERROR ( NF90_INQ_VARID(NCID,'lat',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,D1LAT),'reading data' ) + !*** lat, lon + CALL NCERROR ( NF90_INQ_VARID(NCID,'lat',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,D1LAT),'reading data' ) -CALL NCERROR ( NF90_INQ_VARID(NCID,'lon',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,D1LON),'reading data' ) + CALL NCERROR ( NF90_INQ_VARID(NCID,'lon',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,D1LON),'reading data' ) -CALL NCERROR( NF90_CLOSE(NCID)) + CALL NCERROR( NF90_CLOSE(NCID)) -END SUBROUTINE READ_MAP_CDF + END SUBROUTINE READ_MAP_CDF #endif -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CALC_REGION !! evenly allocate pixels to mpi nodes (updated in v4.03. MPI region given from file) -USE YOS_CMF_INPUT, ONLY: IMIS + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CALC_REGION !! evenly allocate pixels to mpi nodes (updated in v4.03. MPI region given from file) + USE YOS_CMF_INPUT, only: IMIS #ifdef UseCDF_CMF -USE CMF_UTILS_MOD, ONLY: NCERROR -USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR + USE NETCDF #endif -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM),ALLOCATABLE :: REGIONGRID(:) -! -INTEGER(KIND=JPIM),SAVE :: IX,IY -INTEGER(KIND=JPIM),SAVE :: IREGION + IMPLICIT NONE + !* local variables + integer(KIND=JPIM),ALLOCATABLE :: REGIONGRID(:) + ! + integer(KIND=JPIM),SAVE :: IX,IY + integer(KIND=JPIM),SAVE :: IREGION #ifdef UseCDF_CMF -INTEGER(KIND=JPIM) :: NCID,VARID + integer(KIND=JPIM) :: NCID,VARID #endif !$OMP THREADPRIVATE (IX) -!================================================ -WRITE(LOGNAM,*) 'RIVMAP_INIT: region code' + !================================================ + write(LOGNAM,*) 'RIVMAP_INIT: region code' -!*** read MPI region map -REGIONALL=1 -I2REGION(:,:)=IMIS + !*** read MPI region map + REGIONALL=1 + I2REGION(:,:)=IMIS !$OMP PARALLEL DO -DO IY=1, NY - DO IX=1, NX - IF( I2NEXTX(IX,IY)/=IMIS ) THEN - I2REGION(IX,IY)=1 - ENDIF - END DO -END DO + DO IY=1, NY + DO IX=1, NX + IF( I2NEXTX(IX,IY)/=IMIS ) THEN + I2REGION(IX,IY)=1 + ENDIF + ENDDO + ENDDO !$OMP END PARALLEL DO -!! Use MPI: read MPI region map, allocate regions to MPI nodes + !! Use MPI: read MPI region map, allocate regions to MPI nodes #ifdef UseMPI_CMF - IF ( LMAPCDF ) THEN + IF ( LMAPCDF ) THEN #ifdef UseCDF_CMF - CALL NCERROR (NF90_OPEN(CMPIREGNC,NF90_NOWRITE,NCID),'opening '//TRIM(CMPIREGNC) ) - CALL NCERROR (NF90_INQ_VARID(NCID, 'mpireg',VARID),'getting id' ) - CALL NCERROR (NF90_GET_VAR(NCID,VARID,I2REGION),'reading data' ) - CALL NCERROR (NF90_CLOSE(NCID)) + CALL NCERROR (NF90_OPEN(CMPIREGNC,NF90_NOWRITE,NCID),'opening '//TRIM(CMPIREGNC) ) + CALL NCERROR (NF90_INQ_VARID(NCID, 'mpireg',VARID),'getting id' ) + CALL NCERROR (NF90_GET_VAR(NCID,VARID,I2REGION),'reading data' ) + CALL NCERROR (NF90_CLOSE(NCID)) #endif - ELSE - WRITE(LOGNAM,*)'RIVMAP_INIT: read MPI region: ',TRIM(CNEXTXY) - TMPNAM=INQUIRE_FID() - OPEN(TMPNAM,FILE=CMPIREG,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) - READ(TMPNAM,REC=1) I2REGION - CLOSE(TMPNAM) - ENDIF - - REGIONALL=1 + ELSE + write(LOGNAM,*)'RIVMAP_INIT: read MPI region: ',TRIM(CNEXTXY) + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CMPIREG,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) I2REGION + close(TMPNAM) + ENDIF + + REGIONALL=1 !$OMP PARALLEL DO REDUCTION(max:REGIONALL) - DO IY=1, NY - DO IX=1, NX - REGIONALL=MAX( REGIONALL, I2REGION(IX,IY) ) - END DO - END DO + DO IY=1, NY + DO IX=1, NX + REGIONALL=MAX( REGIONALL, I2REGION(IX,IY) ) + ENDDO + ENDDO !$OMP END PARALLEL DO #endif -WRITE(LOGNAM,*)'RIVMAP_INIT: count number of grid in each region: ' -ALLOCATE(REGIONGRID(REGIONALL)) -REGIONGRID(:)=0 -!! OMP reduction operation for array might not be available in some environment -DO IY=1, NY - DO IX=1, NX - IF( I2REGION(IX,IY)>0 ) THEN - IREGION=I2REGION(IX,IY) - REGIONGRID(IREGION)=REGIONGRID(IREGION)+1 - ENDIF - END DO -END DO - -NSEQMAX=0 -DO IREGION=1, REGIONALL - NSEQMAX=MAX(NSEQMAX,REGIONGRID(IREGION)) !! maximum nseqall among all MPI region -END DO - -WRITE(LOGNAM,*) 'CALC_REGION: REGIONALL= ', REGIONALL -WRITE(LOGNAM,*) 'CALC_REGION: NSEQMAX=' , NSEQMAX -WRITE(LOGNAM,*) 'CALC_REGION: NSEQALL=' , NSEQALL - -END SUBROUTINE CALC_REGION -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CALC_1D_SEQ -! OpenMP is not used, because results of this subroutine highly depents on calculation order -USE YOS_CMF_INPUT, ONLY: IMIS -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM) :: IX,IY,JX,JY,ISEQ,JSEQ,ISEQ1,ISEQ2,AGAIN - -INTEGER(KIND=JPIM),ALLOCATABLE :: NUPST(:,:), UPNOW(:,:) -!================================================ -WRITE(LOGNAM,*) 'RIVMAP_INIT: convert 2D map to 1D sequence' - -ALLOCATE( NUPST(NX,NY) ) -ALLOCATE( UPNOW(NX,NY) ) - -ALLOCATE( I1SEQX(NSEQMAX) ) -ALLOCATE( I1SEQY(NSEQMAX) ) -ALLOCATE( I1NEXT(NSEQMAX) ) -ALLOCATE( I2VECTOR(NX,NY) ) -I1SEQX(:)=0 -I1SEQY(:)=0 -I1NEXT(:)=0 -I2VECTOR(:,:)=0 - -! count number of upstream -NUPST(:,:)=0 -UPNOW(:,:)=0 -DO IY=1, NY - DO IX=1, NX - IF( I2NEXTX(IX,IY).GT.0 .and. I2REGION(IX,IY)==REGIONTHIS )THEN - JX=I2NEXTX(IX,IY) - JY=I2NEXTY(IX,IY) - NUPST(JX,JY)=NUPST(JX,JY)+1 - ENDIF - END DO -END DO - -! register upmost grid in 1d sequence -ISEQ=0 -DO IY=1, NY - DO IX=1, NX - IF( I2NEXTX(IX,IY).GT.0 .and. I2REGION(IX,IY)==REGIONTHIS )THEN - IF( NUPST(IX,IY)==UPNOW(IX,IY) )THEN - ISEQ=ISEQ+1 - I1SEQX(ISEQ)=IX - I1SEQY(ISEQ)=IY - I2VECTOR(IX,IY)=ISEQ - ENDIF - ENDIF - END DO -END DO -ISEQ1=1 -ISEQ2=ISEQ - -AGAIN=1 -DO WHILE( AGAIN==1 ) - AGAIN=0 - JSEQ=ISEQ2 - DO ISEQ=ISEQ1, ISEQ2 - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - JX=I2NEXTX(IX,IY) - JY=I2NEXTY(IX,IY) - UPNOW(JX,JY)=UPNOW(JX,JY)+1 - IF( UPNOW(JX,JY)==NUPST(JX,JY) .and. I2NEXTX(JX,JY)>0 )THEN !! if all upstream calculated, register to 1D sequence - JSEQ=JSEQ+1 - I1SEQX(JSEQ)=JX - I1SEQY(JSEQ)=JY - I2VECTOR(JX,JY)=JSEQ - AGAIN=1 - ENDIF - END DO - ISEQ1=ISEQ2+1 - ISEQ2=JSEQ -END DO -NSEQRIV=JSEQ - -ISEQ=NSEQRIV -DO IY=1, NY - DO IX=1, NX - IF( I2NEXTX(IX,IY).LT.0 .AND. I2NEXTX(IX,IY).NE.IMIS .AND. I2REGION(IX,IY)==REGIONTHIS )THEN - ISEQ=ISEQ+1 - I1SEQX(ISEQ)=IX - I1SEQY(ISEQ)=IY - I2VECTOR(IX,IY)=ISEQ - ENDIF - END DO -END DO -NSEQALL=ISEQ - -DO ISEQ=1, NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - IF( I2NEXTX(IX,IY)>0 )THEN - JX=I2NEXTX(IX,IY) - JY=I2NEXTY(IX,IY) - I1NEXT(ISEQ)=I2VECTOR(JX,JY) - ELSE - I1NEXT(ISEQ)=I2NEXTX(IX,IY) - ENDIF -END DO - -DEALLOCATE(NUPST,UPNOW) - -END SUBROUTINE CALC_1D_SEQ -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE READ_BIFPARAM !! evenly allocate pixels to mpi nodes (not used in vcurrent version) -USE YOS_CMF_INPUT, ONLY: PMANRIV, PMANFLD -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN,& - & PTH_DST, PTH_ELV, PTH_WTH, PTH_MAN -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM) :: IX,IY, JX,JY -INTEGER(KIND=JPIM) :: IPTH, ILEV, NPTHOUT1 -REAL(KIND=JPRB) :: PELV, PWTH, PDPH -!================================================ -WRITE(LOGNAM,*)"RIVMAP_INIT: Bifuraction channel:", TRIM(CPTHOUT) - -TMPNAM=INQUIRE_FID() -OPEN(TMPNAM,FILE=CPTHOUT,FORM='FORMATTED') -READ(TMPNAM,*) NPTHOUT,NPTHLEV - -WRITE(LOGNAM,*) "Bifurcation channel dimantion", NPTHOUT, NPTHLEV - -ALLOCATE( PTH_UPST(NPTHOUT) ) -ALLOCATE( PTH_DOWN(NPTHOUT) ) -ALLOCATE( PTH_DST(NPTHOUT) ) -ALLOCATE( PTH_ELV(NPTHOUT,NPTHLEV) ) -ALLOCATE( PTH_WTH(NPTHOUT,NPTHLEV) ) -ALLOCATE( PTH_MAN(NPTHLEV) ) - -NPTHOUT1=0 -DO IPTH=1, NPTHOUT - READ(TMPNAM,*) IX, IY, JX, JY, PTH_DST(IPTH), PELV, PDPH, (PTH_WTH(IPTH,ILEV),ILEV=1,NPTHLEV) - PTH_UPST(IPTH)=I2VECTOR(IX,IY) - PTH_DOWN(IPTH)=I2VECTOR(JX,JY) - IF (PTH_UPST(IPTH) > 0 .AND. PTH_DOWN(IPTH) > 0) THEN - NPTHOUT1=NPTHOUT1+1 - ENDIF - DO ILEV=1, NPTHLEV - IF( ILEV==1 )THEN !!ILEV=1: water channel bifurcation. consider bifurcation channel depth - PWTH=PTH_WTH(IPTH,ILEV) - IF( PWTH>0 )then - PTH_ELV(IPTH,ILEV)=PELV - PDPH + write(LOGNAM,*)'RIVMAP_INIT: count number of grid in each region: ' + allocate(REGIONGRID(REGIONALL)) + REGIONGRID(:)=0 + !! OMP reduction operation for array might not be available in some environment + DO IY=1, NY + DO IX=1, NX + IF( I2REGION(IX,IY)>0 ) THEN + IREGION=I2REGION(IX,IY) + REGIONGRID(IREGION)=REGIONGRID(IREGION)+1 + ENDIF + ENDDO + ENDDO + + NSEQMAX=0 + DO IREGION=1, REGIONALL + NSEQMAX=MAX(NSEQMAX,REGIONGRID(IREGION)) !! maximum nseqall among all MPI region + ENDDO + + write(LOGNAM,*) 'CALC_REGION: REGIONALL= ', REGIONALL + write(LOGNAM,*) 'CALC_REGION: NSEQMAX=' , NSEQMAX + write(LOGNAM,*) 'CALC_REGION: NSEQALL=' , NSEQALL + + END SUBROUTINE CALC_REGION + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CALC_1D_SEQ + ! OpenMP is not used, because results of this subroutine highly depents on calculation order + USE YOS_CMF_INPUT, only: IMIS + IMPLICIT NONE + !* local variables + integer(KIND=JPIM) :: IX,IY,JX,JY,ISEQ,JSEQ,ISEQ1,ISEQ2,AGAIN + + integer(KIND=JPIM),ALLOCATABLE :: NUPST(:,:), UPNOW(:,:) + !================================================ + write(LOGNAM,*) 'RIVMAP_INIT: convert 2D map to 1D sequence' + + allocate( NUPST(NX,NY) ) + allocate( UPNOW(NX,NY) ) + + allocate( I1SEQX(NSEQMAX) ) + allocate( I1SEQY(NSEQMAX) ) + allocate( I1NEXT(NSEQMAX) ) + allocate( I2VECTOR(NX,NY) ) + I1SEQX(:)=0 + I1SEQY(:)=0 + I1NEXT(:)=0 + I2VECTOR(:,:)=0 + + ! count number of upstream + NUPST(:,:)=0 + UPNOW(:,:)=0 + DO IY=1, NY + DO IX=1, NX + IF( I2NEXTX(IX,IY).gt.0 .and. I2REGION(IX,IY)==REGIONTHIS )THEN + JX=I2NEXTX(IX,IY) + JY=I2NEXTY(IX,IY) + NUPST(JX,JY)=NUPST(JX,JY)+1 + ENDIF + ENDDO + ENDDO + + ! register upmost grid in 1d sequence + ISEQ=0 + DO IY=1, NY + DO IX=1, NX + IF( I2NEXTX(IX,IY).gt.0 .and. I2REGION(IX,IY)==REGIONTHIS )THEN + IF( NUPST(IX,IY)==UPNOW(IX,IY) )THEN + ISEQ=ISEQ+1 + I1SEQX(ISEQ)=IX + I1SEQY(ISEQ)=IY + I2VECTOR(IX,IY)=ISEQ + ENDIF + ENDIF + ENDDO + ENDDO + ISEQ1=1 + ISEQ2=ISEQ + + AGAIN=1 + DO WHILE( AGAIN==1 ) + AGAIN=0 + JSEQ=ISEQ2 + DO ISEQ=ISEQ1, ISEQ2 + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + JX=I2NEXTX(IX,IY) + JY=I2NEXTY(IX,IY) + UPNOW(JX,JY)=UPNOW(JX,JY)+1 + IF( UPNOW(JX,JY)==NUPST(JX,JY) .and. I2NEXTX(JX,JY)>0 )THEN !! if all upstream calculated, register to 1D sequence + JSEQ=JSEQ+1 + I1SEQX(JSEQ)=JX + I1SEQY(JSEQ)=JY + I2VECTOR(JX,JY)=JSEQ + AGAIN=1 + ENDIF + ENDDO + ISEQ1=ISEQ2+1 + ISEQ2=JSEQ + ENDDO + NSEQRIV=JSEQ + + ISEQ=NSEQRIV + DO IY=1, NY + DO IX=1, NX + IF( I2NEXTX(IX,IY).lt.0 .and. I2NEXTX(IX,IY).NE.IMIS .and. I2REGION(IX,IY)==REGIONTHIS )THEN + ISEQ=ISEQ+1 + I1SEQX(ISEQ)=IX + I1SEQY(ISEQ)=IY + I2VECTOR(IX,IY)=ISEQ + ENDIF + ENDDO + ENDDO + NSEQALL=ISEQ + + DO ISEQ=1, NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + IF( I2NEXTX(IX,IY)>0 )THEN + JX=I2NEXTX(IX,IY) + JY=I2NEXTY(IX,IY) + I1NEXT(ISEQ)=I2VECTOR(JX,JY) + ELSE + I1NEXT(ISEQ)=I2NEXTX(IX,IY) + ENDIF + ENDDO + + deallocate(NUPST,UPNOW) + + END SUBROUTINE CALC_1D_SEQ + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE READ_BIFPARAM !! evenly allocate pixels to mpi nodes (not used in vcurrent version) + USE YOS_CMF_INPUT, only: PMANRIV, PMANFLD + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN,& + & PTH_DST, PTH_ELV, PTH_WTH, PTH_MAN + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !* local variables + integer(KIND=JPIM) :: IX,IY, JX,JY + integer(KIND=JPIM) :: IPTH, ILEV, NPTHOUT1 + real(KIND=JPRB) :: PELV, PWTH, PDPH + !================================================ + write(LOGNAM,*)"RIVMAP_INIT: Bifuraction channel:", TRIM(CPTHOUT) + + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CPTHOUT,FORM='FORMATTED') + read(TMPNAM,*) NPTHOUT,NPTHLEV + + write(LOGNAM,*) "Bifurcation channel dimantion", NPTHOUT, NPTHLEV + + allocate( PTH_UPST(NPTHOUT) ) + allocate( PTH_DOWN(NPTHOUT) ) + allocate( PTH_DST(NPTHOUT) ) + allocate( PTH_ELV(NPTHOUT,NPTHLEV) ) + allocate( PTH_WTH(NPTHOUT,NPTHLEV) ) + allocate( PTH_MAN(NPTHLEV) ) + + NPTHOUT1=0 + DO IPTH=1, NPTHOUT + READ(TMPNAM,*) IX, IY, JX, JY, PTH_DST(IPTH), PELV, PDPH, (PTH_WTH(IPTH,ILEV),ILEV=1,NPTHLEV) + PTH_UPST(IPTH)=I2VECTOR(IX,IY) + PTH_DOWN(IPTH)=I2VECTOR(JX,JY) + IF (PTH_UPST(IPTH) > 0 .and. PTH_DOWN(IPTH) > 0) THEN + NPTHOUT1=NPTHOUT1+1 + ENDIF + DO ILEV=1, NPTHLEV + IF( ILEV==1 )THEN !!ILEV=1: water channel bifurcation. consider bifurcation channel depth + PWTH=PTH_WTH(IPTH,ILEV) + IF( PWTH>0 )THEN + PTH_ELV(IPTH,ILEV)=PELV - PDPH + ELSE + PTH_ELV(IPTH,ILEV)=1.E20 + ENDIF + ELSE + PWTH=PTH_WTH(IPTH,ILEV) + IF( PWTH>0 )THEN + PTH_ELV(IPTH,ILEV)=PELV + ILEV - 2.0 !! ILEV=2: bank top level + ELSE + PTH_ELV(IPTH,ILEV)=1.E20 + ENDIF + ENDIF + ENDDO + ENDDO + close(TMPNAM) + + DO ILEV=1, NPTHLEV + IF( ILEV==1 )THEN + PTH_MAN(ILEV)=PMANRIV + ELSE + PTH_MAN(ILEV)=PMANFLD + ENDIF + ENDDO + + IF (NPTHOUT /= NPTHOUT1) THEN + write(LOGNAM,*)"Bifuraction channel outside of domain. Only valid:", NPTHOUT1 + ENDIF + + END SUBROUTINE READ_BIFPARAM + !========================================================== + + END SUBROUTINE CMF_RIVMAP_INIT +!#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_TOPO_INIT + ! read & set topography map + ! -- call from CMF_DRV_INIT + USE YOS_CMF_INPUT, only: TMPNAM, NX,NY,NLFP, LMAPEND, & + & LFPLAIN, LMEANSL, LGDWDLY, LSLPMIX, LSLOPEMOUTH + USE YOS_CMF_MAP, only: D2NXTDST, D2GRAREA, D2ELEVTN, D2RIVLEN, & + & D2RIVWTH, D2RIVHGT, D2FLDHGT, D2RIVELV, & + & D2FLDGRD, D2RIVMAN, D2RIVSTOMAX, D2FLDSTOMAX, & + & DFRCINC, NSEQALL, NSEQMAX, D2MEANSL, D2DWNELV, & + & D2GDWDLY, I2MASK + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + write(LOGNAM,*) 'CMF::TOPO_INIT: topography map initialization' + + ! *** 1. allocate ARRAYS + allocate( D2GRAREA(NSEQMAX,1) ) + allocate( D2ELEVTN(NSEQMAX,1) ) + allocate( D2NXTDST(NSEQMAX,1) ) + allocate( D2RIVLEN(NSEQMAX,1) ) + allocate( D2RIVWTH(NSEQMAX,1) ) + allocate( D2RIVHGT(NSEQMAX,1) ) + allocate( D2FLDHGT(NSEQMAX,1,NLFP) ) + allocate( D2RIVMAN(NSEQMAX,1) ) + allocate( D2MEANSL(NSEQMAX,1) ) + allocate( D2DWNELV(NSEQMAX,1) ) + allocate( D2GDWDLY(NSEQMAX,1) ) + allocate( I2MASK(NSEQMAX,1) ) + + D2GRAREA(:,:) =0._JPRB + D2ELEVTN(:,:) =0._JPRB + D2NXTDST(:,:) =0._JPRB + D2RIVLEN(:,:) =0._JPRB + D2RIVWTH(:,:) =0._JPRB + D2RIVHGT(:,:) =0._JPRB + D2FLDHGT(:,:,:)=0._JPRB + D2RIVMAN(:,:) =0._JPRB + D2MEANSL(:,:) =0._JPRB + D2DWNELV(:,:) =0._JPRB + D2GDWDLY(:,:) =0._JPRB + I2MASK(:,:) =0._JPIM !! mask for calculation (IFS slopemix: Kinemacti Wave for Mask=1; Reservoir: dam=2, dam upstream=1) + + !============================ + ! *** 2. Read topo map + write(LOGNAM,*) 'CMF::TOPO_INIT: read topography maps' + IF ( .not. LMAPCDF ) THEN + CALL READ_TOPO_BIN ELSE - PTH_ELV(IPTH,ILEV)=1.E20 + CALL READ_TOPO_CDF ENDIF - ELSE - PWTH=PTH_WTH(IPTH,ILEV) - IF( PWTH>0 )then - PTH_ELV(IPTH,ILEV)=PELV + ILEV - 2.0 !! ILEV=2: bank top level + + !============================ + ! *** 3a. Calc Channel Parameters + write(LOGNAM,*) 'TOPO_INIT: calc river channel parameters' + + allocate(D2RIVSTOMAX(NSEQMAX,1)) + allocate(D2RIVELV(NSEQMAX,1)) + + IF ( LFPLAIN ) THEN + D2RIVSTOMAX(:,:) = D2RIVLEN(:,:) * D2RIVWTH(:,:) * D2RIVHGT(:,:) ELSE - PTH_ELV(IPTH,ILEV)=1.E20 + write(LOGNAM,*) 'TOPO_INIT: no floodplain (rivstomax=1.D18)' + D2RIVSTOMAX(:,:) = 1.E18 ENDIF - ENDIF - END DO -END DO -CLOSE(TMPNAM) - -DO ILEV=1, NPTHLEV - IF( ILEV==1 )THEN - PTH_MAN(ILEV)=PMANRIV - ELSE - PTH_MAN(ILEV)=PMANFLD - ENDIF -END DO - -IF (NPTHOUT /= NPTHOUT1) THEN - WRITE(LOGNAM,*)"Bifuraction channel outside of domain. Only valid:", NPTHOUT1 -ENDIF - -END SUBROUTINE READ_BIFPARAM -!========================================================== + D2RIVELV(:,:) = D2ELEVTN(:,:) - D2RIVHGT(:,:) -END SUBROUTINE CMF_RIVMAP_INIT -!#################################################################### + !*** 3b. Calc Channel Parameters + write(LOGNAM,*) 'TOPO_INIT: calc floodplain parameters' + allocate(D2FLDSTOMAX(NSEQMAX,1,NLFP)) + allocate(D2FLDGRD(NSEQMAX,1,NLFP)) + CALL SET_FLDSTG + !*** 3c. Calc downstream boundary + write(LOGNAM,*) 'TOPO_INIT: calc downstream boundary elevation' + D2DWNELV(:,:)=D2ELEVTN(:,:) + IF( LMEANSL ) THEN + D2DWNELV(:,:)=D2ELEVTN(:,:)+D2MEANSL(:,:) + ENDIF + CONTAINS + !========================================================== + !+ READ_TOPO_BIN + !+ READ_TOPO_CDF + !+ SET_FLDSTG + !+ SET_SLOPEMIX + !========================================================== + SUBROUTINE READ_TOPO_BIN + USE CMF_UTILS_MOD, only: mapR2vecD, CONV_END, INQUIRE_FID + IMPLICIT NONE + !* local variables + integer(KIND=JPIM) :: ILFP + real(KIND=JPRM),ALLOCATABLE :: R2TEMP(:,:) + real(KIND=JPRB),ALLOCATABLE :: D2TEMP(:,:) + !================================================ + allocate(R2TEMP(NX,NY)) + allocate(D2TEMP(NSEQMAX,1)) + + TMPNAM=INQUIRE_FID() + + write(LOGNAM,*)'TOPO_INIT: unit-catchment area : ',TRIM(CGRAREA) + open(TMPNAM,FILE=CGRAREA,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2GRAREA) + close(TMPNAM) + + write(LOGNAM,*)'TOPO_INIT: ground elevation : ',TRIM(CELEVTN) + open(TMPNAM,FILE=CELEVTN,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2ELEVTN) + close(TMPNAM) + + write(LOGNAM,*)'TOPO_INIT: downstream distance : ',TRIM(CNXTDST) + open(TMPNAM,FILE=CNXTDST,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2NXTDST) + close(TMPNAM) + + write(LOGNAM,*)'TOPO_INIT: river channel length : ',TRIM(CRIVLEN) + open(TMPNAM,FILE=CRIVLEN,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2RIVLEN) + close(TMPNAM) + + write(LOGNAM,*)'TOPO_INIT: floodplain elevation profile : ',TRIM(CFLDHGT) + open(TMPNAM,FILE=TRIM(CFLDHGT),FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + DO ILFP=1,NLFP + READ(TMPNAM,REC=ILFP) R2TEMP + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2TEMP) + D2FLDHGT(:,:,ILFP)= D2TEMP(:,:) + ENDDO + close(TMPNAM) + + !*** river channel / groundwater parameters) + + write(LOGNAM,*)'TOPO_INIT: river channel depth : ',TRIM(CRIVHGT) + open(TMPNAM,FILE=CRIVHGT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2RIVHGT) + close(TMPNAM) + + write(LOGNAM,*)'TOPO_INIT: river channel width : ',TRIM(CRIVWTH) + open(TMPNAM,FILE=CRIVWTH,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2RIVWTH) + close(TMPNAM) + + write(LOGNAM,*)'TOPO_INIT: manning coefficient river: ',TRIM(CRIVMAN) + open(TMPNAM,FILE=TRIM(CRIVMAN),FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2RIVMAN) + close(TMPNAM) + + IF( LGDWDLY )THEN + write(LOGNAM,*)'TOPO_INIT: groundwater delay parameter: ',TRIM(CGDWDLY) + open(TMPNAM,FILE=TRIM(CGDWDLY),FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + read(TMPNAM,REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP,D2GDWDLY) + close(TMPNAM) + ENDIF + IF( LSLPMIX )THEN + write(LOGNAM,*)'TOPO_INIT: LSLPMIX only used in IFS, not availabke with binary map' + ENDIF + IF( LSLOPEMOUTH )THEN + write(LOGNAM,*)'TOPO_INIT: LSLOPEMOUTH only used in IFS, not availabke with binary map' + ENDIF -!#################################################################### -SUBROUTINE CMF_TOPO_INIT -! read & set topography map -! -- call from CMF_DRV_INIT -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX,NY,NLFP, LMAPEND, & - & LFPLAIN, LMEANSL, LGDWDLY, LSLPMIX, LSLOPEMOUTH -USE YOS_CMF_MAP, ONLY: D2NXTDST, D2GRAREA, D2ELEVTN, D2RIVLEN, & - & D2RIVWTH, D2RIVHGT, D2FLDHGT, D2RIVELV, & - & D2FLDGRD, D2RIVMAN, D2RIVSTOMAX, D2FLDSTOMAX, & - & DFRCINC, NSEQALL, NSEQMAX, D2MEANSL, D2DWNELV, & - & D2GDWDLY, I2MASK -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -WRITE(LOGNAM,*) 'CMF::TOPO_INIT: topography map initialization' - -! *** 1. ALLOCATE ARRAYS -ALLOCATE( D2GRAREA(NSEQMAX,1) ) -ALLOCATE( D2ELEVTN(NSEQMAX,1) ) -ALLOCATE( D2NXTDST(NSEQMAX,1) ) -ALLOCATE( D2RIVLEN(NSEQMAX,1) ) -ALLOCATE( D2RIVWTH(NSEQMAX,1) ) -ALLOCATE( D2RIVHGT(NSEQMAX,1) ) -ALLOCATE( D2FLDHGT(NSEQMAX,1,NLFP) ) -ALLOCATE( D2RIVMAN(NSEQMAX,1) ) -ALLOCATE( D2MEANSL(NSEQMAX,1) ) -ALLOCATE( D2DWNELV(NSEQMAX,1) ) -ALLOCATE( D2GDWDLY(NSEQMAX,1) ) -ALLOCATE( I2MASK(NSEQMAX,1) ) - -D2GRAREA(:,:) =0._JPRB -D2ELEVTN(:,:) =0._JPRB -D2NXTDST(:,:) =0._JPRB -D2RIVLEN(:,:) =0._JPRB -D2RIVWTH(:,:) =0._JPRB -D2RIVHGT(:,:) =0._JPRB -D2FLDHGT(:,:,:)=0._JPRB -D2RIVMAN(:,:) =0._JPRB -D2MEANSL(:,:) =0._JPRB -D2DWNELV(:,:) =0._JPRB -D2GDWDLY(:,:) =0._JPRB -I2MASK(:,:) =0._JPIM !! mask for calculation (IFS slopemix: Kinemacti Wave for Mask=1; Reservoir: dam=2, dam upstream=1) - -!============================ -! *** 2. Read topo map -WRITE(LOGNAM,*) 'CMF::TOPO_INIT: read topography maps' -IF ( .not. LMAPCDF ) THEN - CALL READ_TOPO_BIN -ELSE - CALL READ_TOPO_CDF -ENDIF - -!============================ -! *** 3a. Calc Channel Parameters -WRITE(LOGNAM,*) 'TOPO_INIT: calc river channel parameters' - -ALLOCATE(D2RIVSTOMAX(NSEQMAX,1)) -ALLOCATE(D2RIVELV(NSEQMAX,1)) - -IF ( LFPLAIN ) THEN - D2RIVSTOMAX(:,:) = D2RIVLEN(:,:) * D2RIVWTH(:,:) * D2RIVHGT(:,:) -ELSE - WRITE(LOGNAM,*) 'TOPO_INIT: no floodplain (rivstomax=1.D18)' - D2RIVSTOMAX(:,:) = 1.E18 -ENDIF -D2RIVELV(:,:) = D2ELEVTN(:,:) - D2RIVHGT(:,:) - -!*** 3b. Calc Channel Parameters -WRITE(LOGNAM,*) 'TOPO_INIT: calc floodplain parameters' - -ALLOCATE(D2FLDSTOMAX(NSEQMAX,1,NLFP)) -ALLOCATE(D2FLDGRD(NSEQMAX,1,NLFP)) -CALL SET_FLDSTG - -!*** 3c. Calc downstream boundary -WRITE(LOGNAM,*) 'TOPO_INIT: calc downstream boundary elevation' -D2DWNELV(:,:)=D2ELEVTN(:,:) -IF( LMEANSL ) THEN - D2DWNELV(:,:)=D2ELEVTN(:,:)+D2MEANSL(:,:) -ENDIF + ! ========== -CONTAINS -!========================================================== -!+ READ_TOPO_BIN -!+ READ_TOPO_CDF -!+ SET_FLDSTG -!+ SET_SLOPEMIX -!========================================================== -SUBROUTINE READ_TOPO_BIN -USE CMF_UTILS_MOD, ONLY: mapR2vecD, CONV_END, INQUIRE_FID -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM) :: ILFP -REAL(KIND=JPRM),ALLOCATABLE :: R2TEMP(:,:) -REAL(KIND=JPRB),ALLOCATABLE :: D2TEMP(:,:) -!================================================ -ALLOCATE(R2TEMP(NX,NY)) -ALLOCATE(D2TEMP(NSEQMAX,1)) - -TMPNAM=INQUIRE_FID() - -WRITE(LOGNAM,*)'TOPO_INIT: unit-catchment area : ',TRIM(CGRAREA) -OPEN(TMPNAM,FILE=CGRAREA,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2GRAREA) -CLOSE(TMPNAM) - -WRITE(LOGNAM,*)'TOPO_INIT: ground elevation : ',TRIM(CELEVTN) -OPEN(TMPNAM,FILE=CELEVTN,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2ELEVTN) -CLOSE(TMPNAM) - -WRITE(LOGNAM,*)'TOPO_INIT: downstream distance : ',TRIM(CNXTDST) -OPEN(TMPNAM,FILE=CNXTDST,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2NXTDST) -CLOSE(TMPNAM) - -WRITE(LOGNAM,*)'TOPO_INIT: river channel length : ',TRIM(CRIVLEN) -OPEN(TMPNAM,FILE=CRIVLEN,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2RIVLEN) -CLOSE(TMPNAM) - -WRITE(LOGNAM,*)'TOPO_INIT: floodplain elevation profile : ',TRIM(CFLDHGT) -OPEN(TMPNAM,FILE=TRIM(CFLDHGT),FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -DO ILFP=1,NLFP - READ(TMPNAM,REC=ILFP) R2TEMP - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) - CALL mapR2vecD(R2TEMP,D2TEMP) - D2FLDHGT(:,:,ILFP)= D2TEMP(:,:) -ENDDO -CLOSE(TMPNAM) - -!*** river channel / groundwater parameters) - -WRITE(LOGNAM,*)'TOPO_INIT: river channel depth : ',TRIM(CRIVHGT) -OPEN(TMPNAM,FILE=CRIVHGT,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2RIVHGT) -CLOSE(TMPNAM) - -WRITE(LOGNAM,*)'TOPO_INIT: river channel width : ',TRIM(CRIVWTH) -OPEN(TMPNAM,FILE=CRIVWTH,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2RIVWTH) -CLOSE(TMPNAM) - -WRITE(LOGNAM,*)'TOPO_INIT: manning coefficient river: ',TRIM(CRIVMAN) -OPEN(TMPNAM,FILE=TRIM(CRIVMAN),FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) -CALL mapR2vecD(R2TEMP,D2RIVMAN) -CLOSE(TMPNAM) - -IF( LGDWDLY )THEN - WRITE(LOGNAM,*)'TOPO_INIT: groundwater delay parameter: ',TRIM(CGDWDLY) - OPEN(TMPNAM,FILE=TRIM(CGDWDLY),FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) - READ(TMPNAM,REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) - CALL mapR2vecD(R2TEMP,D2GDWDLY) - CLOSE(TMPNAM) -ENDIF - -IF( LSLPMIX )THEN - WRITE(LOGNAM,*)'TOPO_INIT: LSLPMIX only used in IFS, not availabke with binary map' -ENDIF -IF( LSLOPEMOUTH )THEN - WRITE(LOGNAM,*)'TOPO_INIT: LSLOPEMOUTH only used in IFS, not availabke with binary map' -ENDIF - -! ========== - -IF( LMEANSL ) THEN - WRITE(LOGNAM, *)'TOPO_INIT: mean sea level: ', TRIM(CMEANSL) - OPEN(TMPNAM, FILE=CMEANSL, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=4*NX*NY) - READ(TMPNAM, REC=1) R2TEMP(:,:) - IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) - CALL mapR2vecD(R2TEMP, D2MEANSL) - CLOSE(TMPNAM) -ENDIF - -DEALLOCATE(R2TEMP) -DEALLOCATE(D2TEMP) - -END SUBROUTINE READ_TOPO_BIN -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE READ_TOPO_CDF + IF( LMEANSL ) THEN + write(LOGNAM, *)'TOPO_INIT: mean sea level: ', TRIM(CMEANSL) + open(TMPNAM, FILE=CMEANSL, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=4*NX*NY) + read(TMPNAM, REC=1) R2TEMP(:,:) + IF( LMAPEND ) CALL CONV_END(R2TEMP,NX,NY) + CALL mapR2vecD(R2TEMP, D2MEANSL) + close(TMPNAM) + ENDIF + + deallocate(R2TEMP) + deallocate(D2TEMP) + + END SUBROUTINE READ_TOPO_BIN + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE READ_TOPO_CDF #ifdef UseCDF_CMF -USE NETCDF -USE CMF_UTILS_MOD, ONLY: NCERROR,mapR2vecD -USE YOS_CMF_MAP, ONLY: D2ELEVSLOPE !! only used in ECMWF -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM) :: NCID,VARID,STATUS -INTEGER(KIND=JPIM) :: ILEV -REAL(KIND=JPRM),ALLOCATABLE :: R2TEMP(:,:) -REAL(KIND=JPRB),ALLOCATABLE :: D2TEMP(:,:) -!================================================ -ALLOCATE(R2TEMP(NX,NY)) -ALLOCATE(D2TEMP(NSEQMAX,1)) - -!! CLIM FILE -CALL NCERROR (NF90_OPEN(CRIVCLINC,NF90_NOWRITE,NCID),'opening '//TRIM(CRIVCLINC) ) - -WRITE(LOGNAM,*)'TOPO_INIT: ctmare:',TRIM(CRIVCLINC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'ctmare',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2GRAREA) - -WRITE(LOGNAM,*)'TOPO_INIT: elevtn:',TRIM(CRIVCLINC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'elevtn',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2ELEVTN) - -WRITE(LOGNAM,*)'TOPO_INIT: nxtdst:',TRIM(CRIVCLINC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'nxtdst',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2NXTDST) - -WRITE(LOGNAM,*)'TOPO_INIT: rivlen:',TRIM(CRIVCLINC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'rivlen',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2RIVLEN) - -WRITE(LOGNAM,*)'TOPO_INIT: fldhgt:',TRIM(CRIVCLINC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'fldhgt',VARID),'getting id' ) -DO ILEV=1,NLFP - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP,(/1,1,ILEV/),(/NX,NY,1/)),'reading data' ) - CALL mapR2vecD(R2TEMP,D2TEMP) - D2FLDHGT(:,:,ILEV)=D2TEMP(:,:) -ENDDO - -CALL NCERROR( NF90_CLOSE(NCID)) - -IF ( LSLOPEMOUTH ) THEN - ALLOCATE( D2ELEVSLOPE(NSEQMAX,1) ) - WRITE(LOGNAM,*)'TOPO_INIT: elevslope:',TRIM(CRIVPARNC) - STATUS = NF90_INQ_VARID(NCID,'elevslope',VARID) - IF (STATUS /= 0 ) THEN - WRITE(LOGNAM,*)'TOPO_INIT: elevslope: not present, aborting' - STOP 9 - ELSE - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) - ENDIF - CALL mapR2vecD(R2TEMP,D2ELEVSLOPE) -ENDIF - -!!========== -!! PAR FILE (river channel / groundwater parameters) -CALL NCERROR (NF90_OPEN(CRIVPARNC,NF90_NOWRITE,NCID),'opening '//TRIM(CRIVPARNC) ) - -WRITE(LOGNAM,*)'TOPO_INIT: rivwth:',TRIM(CRIVPARNC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'rivwth',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2RIVWTH) - -WRITE(LOGNAM,*)'TOPO_INIT: rivhgt:',TRIM(CRIVPARNC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'rivhgt',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2RIVHGT) - -WRITE(LOGNAM,*)'TOPO_INIT: rivman:',TRIM(CRIVPARNC) -CALL NCERROR ( NF90_INQ_VARID(NCID,'rivman',VARID),'getting id' ) -CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) -CALL mapR2vecD(R2TEMP,D2RIVMAN) - -IF ( LGDWDLY ) THEN - WRITE(LOGNAM,*)'TOPO_INIT: GDWDLY:',TRIM(CRIVPARNC) - STATUS = NF90_INQ_VARID(NCID,'gdwdly',VARID) - IF (STATUS /= 0 ) THEN - WRITE(LOGNAM,*)'TOPO_INIT: GDWDLY: not present, setting to zero' - R2TEMP(:,:) = 0._JPRB - ELSE - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) - ENDIF - CALL mapR2vecD(R2TEMP,D2GDWDLY) -ENDIF - -I2MASK(:,:)=0_JPIM -IF ( LSLPMIX ) THEN - CALL SET_SLOPEMIX -ENDIF - -CALL NCERROR( NF90_CLOSE(NCID)) - -!!========== -!! MEAN SEA LEVEL FILE -IF( LMEANSL ) THEN - CALL NCERROR (NF90_OPEN(CMEANSLNC,NF90_NOWRITE,NCID),'opening '//TRIM(CMEANSLNC) ) - WRITE(LOGNAM,*)'TOPO_INIT: rivhgt:',TRIM(CMEANSLNC) - CALL NCERROR ( NF90_INQ_VARID(NCID,'meansl',VARID),'getting id' ) - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) - CALL mapR2vecD ( R2TEMP,D2MEANSL ) - CALL NCERROR ( NF90_CLOSE(NCID) ) -ENDIF - -DEALLOCATE(R2TEMP) -DEALLOCATE(D2TEMP) + USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR,mapR2vecD + USE YOS_CMF_MAP, only: D2ELEVSLOPE !! only used in ECMWF + IMPLICIT NONE + !* local variables + integer(KIND=JPIM) :: NCID,VARID,STATUS + integer(KIND=JPIM) :: ILEV + real(KIND=JPRM),ALLOCATABLE :: R2TEMP(:,:) + real(KIND=JPRB),ALLOCATABLE :: D2TEMP(:,:) + !================================================ + allocate(R2TEMP(NX,NY)) + allocate(D2TEMP(NSEQMAX,1)) + + !! CLIM FILE + CALL NCERROR (NF90_OPEN(CRIVCLINC,NF90_NOWRITE,NCID),'opening '//TRIM(CRIVCLINC) ) + + write(LOGNAM,*)'TOPO_INIT: ctmare:',TRIM(CRIVCLINC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'ctmare',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2GRAREA) + + write(LOGNAM,*)'TOPO_INIT: elevtn:',TRIM(CRIVCLINC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'elevtn',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2ELEVTN) + + write(LOGNAM,*)'TOPO_INIT: nxtdst:',TRIM(CRIVCLINC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'nxtdst',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2NXTDST) + + write(LOGNAM,*)'TOPO_INIT: rivlen:',TRIM(CRIVCLINC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'rivlen',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2RIVLEN) + + write(LOGNAM,*)'TOPO_INIT: fldhgt:',TRIM(CRIVCLINC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'fldhgt',VARID),'getting id' ) + DO ILEV=1,NLFP + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP,(/1,1,ILEV/),(/NX,NY,1/)),'reading data' ) + CALL mapR2vecD(R2TEMP,D2TEMP) + D2FLDHGT(:,:,ILEV)=D2TEMP(:,:) + ENDDO + + CALL NCERROR( NF90_CLOSE(NCID)) + + IF ( LSLOPEMOUTH ) THEN + allocate( D2ELEVSLOPE(NSEQMAX,1) ) + write(LOGNAM,*)'TOPO_INIT: elevslope:',TRIM(CRIVPARNC) + STATUS = NF90_INQ_VARID(NCID,'elevslope',VARID) + IF (STATUS /= 0 ) THEN + write(LOGNAM,*)'TOPO_INIT: elevslope: not present, aborting' + STOP 9 + ELSE + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + ENDIF + CALL mapR2vecD(R2TEMP,D2ELEVSLOPE) + ENDIF + + !!========== + !! PAR FILE (river channel / groundwater parameters) + CALL NCERROR (NF90_OPEN(CRIVPARNC,NF90_NOWRITE,NCID),'opening '//TRIM(CRIVPARNC) ) + + write(LOGNAM,*)'TOPO_INIT: rivwth:',TRIM(CRIVPARNC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'rivwth',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2RIVWTH) + + write(LOGNAM,*)'TOPO_INIT: rivhgt:',TRIM(CRIVPARNC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'rivhgt',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2RIVHGT) + + write(LOGNAM,*)'TOPO_INIT: rivman:',TRIM(CRIVPARNC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'rivman',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD(R2TEMP,D2RIVMAN) + + IF ( LGDWDLY ) THEN + write(LOGNAM,*)'TOPO_INIT: GDWDLY:',TRIM(CRIVPARNC) + STATUS = NF90_INQ_VARID(NCID,'gdwdly',VARID) + IF (STATUS /= 0 ) THEN + write(LOGNAM,*)'TOPO_INIT: GDWDLY: not present, setting to zero' + R2TEMP(:,:) = 0._JPRB + ELSE + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + ENDIF + CALL mapR2vecD(R2TEMP,D2GDWDLY) + ENDIF + + I2MASK(:,:)=0_JPIM + IF ( LSLPMIX ) THEN + CALL SET_SLOPEMIX + ENDIF + + CALL NCERROR( NF90_CLOSE(NCID)) + + !!========== + !! MEAN SEA LEVEL FILE + IF( LMEANSL ) THEN + CALL NCERROR (NF90_OPEN(CMEANSLNC,NF90_NOWRITE,NCID),'opening '//TRIM(CMEANSLNC) ) + write(LOGNAM,*)'TOPO_INIT: rivhgt:',TRIM(CMEANSLNC) + CALL NCERROR ( NF90_INQ_VARID(NCID,'meansl',VARID),'getting id' ) + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,R2TEMP),'reading data' ) + CALL mapR2vecD ( R2TEMP,D2MEANSL ) + CALL NCERROR ( NF90_CLOSE(NCID) ) + ENDIF + + deallocate(R2TEMP) + deallocate(D2TEMP) #endif -END SUBROUTINE READ_TOPO_CDF -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE SET_FLDSTG -IMPLICIT NONE -!* local variables -INTEGER(KIND=JPIM),SAVE :: ISEQ, I -REAL(KIND=JPRB),SAVE :: DSTONOW -REAL(KIND=JPRB),SAVE :: DSTOPRE -REAL(KIND=JPRB),SAVE :: DHGTPRE -REAL(KIND=JPRB),SAVE :: DWTHINC + END SUBROUTINE READ_TOPO_CDF + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE SET_FLDSTG + IMPLICIT NONE + !* local variables + integer(KIND=JPIM),SAVE :: ISEQ, I + real(KIND=JPRB),SAVE :: DSTONOW + real(KIND=JPRB),SAVE :: DSTOPRE + real(KIND=JPRB),SAVE :: DHGTPRE + real(KIND=JPRB),SAVE :: DWTHINC !$OMP THREADPRIVATE (I,DSTONOW,DSTOPRE,DHGTPRE,DWTHINC) -!================================================ -D2FLDSTOMAX(:,:,:) = 0._JPRB -D2FLDGRD(:,:,:) = 0._JPRB -DFRCINC=dble(NLFP)**(-1.) -! + !================================================ + D2FLDSTOMAX(:,:,:) = 0._JPRB + D2FLDGRD(:,:,:) = 0._JPRB + DFRCINC=dble(NLFP)**(-1.) + ! !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - DSTOPRE = D2RIVSTOMAX(ISEQ,1) - DHGTPRE = 0._JPRB - DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC - DO I=1, NLFP - DSTONOW = D2RIVLEN(ISEQ,1) * ( D2RIVWTH(ISEQ,1) + DWTHINC*(DBLE(I)-0.5) ) * (D2FLDHGT(ISEQ,1,I)-DHGTPRE) - D2FLDSTOMAX(ISEQ,1,I) = DSTOPRE + DSTONOW - D2FLDGRD(ISEQ,1,I) = (D2FLDHGT(ISEQ,1,I)-DHGTPRE) * DWTHINC**(-1.) - DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) - DHGTPRE = D2FLDHGT(ISEQ,1,I) - END DO -END DO + DO ISEQ=1, NSEQALL + DSTOPRE = D2RIVSTOMAX(ISEQ,1) + DHGTPRE = 0._JPRB + DWTHINC = D2GRAREA(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) * DFRCINC + DO I=1, NLFP + DSTONOW = D2RIVLEN(ISEQ,1) * ( D2RIVWTH(ISEQ,1) + DWTHINC*(DBLE(I)-0.5) ) * (D2FLDHGT(ISEQ,1,I)-DHGTPRE) + D2FLDSTOMAX(ISEQ,1,I) = DSTOPRE + DSTONOW + D2FLDGRD(ISEQ,1,I) = (D2FLDHGT(ISEQ,1,I)-DHGTPRE) * DWTHINC**(-1.) + DSTOPRE = D2FLDSTOMAX(ISEQ,1,I) + DHGTPRE = D2FLDHGT(ISEQ,1,I) + ENDDO + ENDDO !$OMP END PARALLEL DO -! -END SUBROUTINE SET_FLDSTG -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE SET_SLOPEMIX !! only used in IFS0 + ! + END SUBROUTINE SET_FLDSTG + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE SET_SLOPEMIX !! only used in IFS0 #ifdef UseCDF_CMF -USE NETCDF -USE CMF_UTILS_MOD, ONLY: NCERROR,mapI2vecI - -IMPLICIT NONE -INTEGER(KIND=JPIM),ALLOCATABLE :: I2TEMP(:,:) -INTEGER(KIND=JPIM) :: ISEQ, I0, I1 -INTEGER(KIND=JPIM) :: NCID,VARID,STATUS - - ALLOCATE(I2TEMP(NX,NY)) - WRITE(LOGNAM,*)'TOPO_INIT: mask_slope:',TRIM(CRIVPARNC) - STATUS = NF90_INQ_VARID(NCID,'mask_slope',VARID) - IF (STATUS /= 0 ) THEN - WRITE(LOGNAM,*)'TOPO_INIT: mask_slope: LSLPMIX should be set to FALSE: ABORTING!' - STOP 9 - ENDIF - CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2TEMP),'reading data' ) - CALL mapI2vecI(I2TEMP,I2MASK) - I0=0 - I1=0 - DO ISEQ=1,NSEQALL - IF (I2MASK(ISEQ,1) == 1 ) THEN !! kinematic wave applied - I1=I1+1 - ENDIF - IF (I2MASK(ISEQ,1) == 0 ) THEN - I0=I0+1 - ENDIF - ENDDO - WRITE(LOGNAM,*)'TOPO_INIT: sum(mask==0), sum(mask==1)',I0,I1 - IF ( I0+I1 .NE. NSEQALL ) THEN - WRITE(LOGNAM,*)'TOPO_INIT: mask==0 + mask == 1 does not match NSEQALL.. something wrong, aborting' - STOP 9 - ENDIF - - DEALLOCATE(I2TEMP) + USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR,mapI2vecI + + IMPLICIT NONE + integer(KIND=JPIM),ALLOCATABLE :: I2TEMP(:,:) + integer(KIND=JPIM) :: ISEQ, I0, I1 + integer(KIND=JPIM) :: NCID,VARID,STATUS + + allocate(I2TEMP(NX,NY)) + write(LOGNAM,*)'TOPO_INIT: mask_slope:',TRIM(CRIVPARNC) + STATUS = NF90_INQ_VARID(NCID,'mask_slope',VARID) + IF (STATUS /= 0 ) THEN + write(LOGNAM,*)'TOPO_INIT: mask_slope: LSLPMIX should be set to FALSE: ABORTING!' + STOP 9 + ENDIF + CALL NCERROR ( NF90_GET_VAR(NCID,VARID,I2TEMP),'reading data' ) + CALL mapI2vecI(I2TEMP,I2MASK) + I0=0 + I1=0 + DO ISEQ=1,NSEQALL + IF (I2MASK(ISEQ,1) == 1 ) THEN !! kinematic wave applied + I1=I1+1 + ENDIF + IF (I2MASK(ISEQ,1) == 0 ) THEN + I0=I0+1 + ENDIF + ENDDO + write(LOGNAM,*)'TOPO_INIT: sum(mask==0), sum(mask==1)',I0,I1 + IF ( I0+I1 .NE. NSEQALL ) THEN + write(LOGNAM,*)'TOPO_INIT: mask==0 + mask == 1 does not match NSEQALL.. something wrong, aborting' + STOP 9 + ENDIF + + deallocate(I2TEMP) #endif -END SUBROUTINE SET_SLOPEMIX + END SUBROUTINE SET_SLOPEMIX -END SUBROUTINE CMF_TOPO_INIT + END SUBROUTINE CMF_TOPO_INIT !#################################################################### diff --git a/CaMa/src/cmf_ctrl_mpi_mod.F90 b/CaMa/src/cmf_ctrl_mpi_mod.F90 index b636c867..d987724d 100755 --- a/CaMa/src/cmf_ctrl_mpi_mod.F90 +++ b/CaMa/src/cmf_ctrl_mpi_mod.F90 @@ -19,212 +19,212 @@ MODULE CMF_CTRL_MPI_MOD ! See the License for the specific language governing permissions and limitations under the License. !========================================================== !** shared variables in module -USE MPI -USE PARKIND1, ONLY: JPIM, JPRB, JPRM, JPRD -USE YOS_CMF_INPUT, ONLY: LOGNAM -USE YOS_CMF_MAP, ONLY: REGIONALL, REGIONTHIS, MPI_COMM_CAMA -!$ USE OMP_LIB -IMPLICIT NONE -!** local variables -!** MPI setting -INTEGER(KIND=JPIM),SAVE :: ierr, Nproc, Nid -INTEGER(KIND=JPIM),SAVE :: iOMP, nOMP -!========================================================== + USE MPI + USE PARKIND1, only: JPIM, JPRB, JPRM, JPRD + USE YOS_CMF_INPUT, only: LOGNAM + USE YOS_CMF_MAP, only: REGIONALL, REGIONTHIS, MPI_COMM_CAMA + !$ USE OMP_LIB + IMPLICIT NONE + !** local variables + !** MPI setting + integer(KIND=JPIM),SAVE :: ierr, Nproc, Nid + integer(KIND=JPIM),SAVE :: iOMP, nOMP + !========================================================== CONTAINS -!#################################################################### -! -- CMF_DRV_INPUT : Set namelist & logfile -! -- CMF_DRV_INIT : Initialize CaMa-Flood -! -- CMF_DRV_END : Finalize CaMa-Flood -! -!#################################################################### -SUBROUTINE CMF_MPI_INIT -IMPLICIT NONE -!================================================ -!*** 0. MPI specific setting -REGIONTHIS=1 -CALL MPI_Init(ierr) - -MPI_COMM_CAMA=MPI_COMM_WORLD -CALL MPI_Comm_size(MPI_COMM_CAMA, Nproc, ierr) -CALL MPI_Comm_rank(MPI_COMM_CAMA, Nid, ierr) - -REGIONALL =Nproc -REGIONTHIS=Nid+1 - -! For BUGFIX: Check MPI / OpenMPI is working or not. -! Write to standard output (log file is not opened yet) -!!!!!#ifdef _OPENMP -!!!!!nOMP = omp_get_max_threads(); -!!!!!!$OMP PARALLEL DO -!!!!!DO iOMP=1, nOMP -!!!!! print *, 'MPI: ', REGIONTHIS, REGIONALL, ' OMP: ', omp_get_thread_num(), nOMP -!!!!!END DO -!!!!!!$OMP END PARALLEL DO -!!!!!#endif - -END SUBROUTINE CMF_MPI_INIT -!#################################################################### - - - -!#################################################################### -SUBROUTINE CMF_MPI_END -IMPLICIT NONE -INTEGER(KIND=JPIM) :: ierr -!================================================ -CALL MPI_Finalize(ierr) -END SUBROUTINE CMF_MPI_END -!#################################################################### - - -!#################################################################### -SUBROUTINE CMF_MPI_AllReduce_R2MAP(R2MAP) -USE YOS_CMF_INPUT, ONLY: NX,NY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRM),INTENT(INOUT) :: R2MAP(NX,NY) -!* local variable -REAL(KIND=JPRM) :: R2TMP(NX,NY) -!================================================ -! gather to master node - R2TMP(:,:)=1.E30 - CALL MPI_AllReduce(R2MAP,R2TMP,NX*NY,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) - R2MAP(:,:)=R2TMP(:,:) -END SUBROUTINE CMF_MPI_AllReduce_R2MAP -!#################################################################### - - - - -!#################################################################### -SUBROUTINE CMF_MPI_AllReduce_R1PTH(R1PTH) -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV -IMPLICIT NONE -!* input/output -REAL(KIND=JPRM),INTENT(INOUT) :: R1PTH(NPTHOUT,NPTHLEV) -!* local variable -REAL(KIND=JPRM) :: R1PTMP(NPTHOUT,NPTHLEV) -!================================================ -! gather to master node - R1PTMP(:,:)=1.E30 - CALL MPI_AllReduce(R1PTH,R1PTMP,NPTHOUT*NPTHLEV,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) - R1PTH(:,:)=R1PTMP(:,:) -END SUBROUTINE CMF_MPI_AllReduce_R1PTH -!#################################################################### - - -!#################################################################### -SUBROUTINE CMF_MPI_AllReduce_D2MAP(D2MAP) -! only used in netCDF restart file. (cannot be compiled due to a bug in MacOS mpif90) -USE YOS_CMF_INPUT, ONLY: NX,NY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRB),INTENT(INOUT) :: D2MAP(NX,NY) -!* local variable -REAL(KIND=JPRB) :: D2TMP(NX,NY) -!================================================ -! gather to master node - D2TMP(:,:)=1.E30 + !#################################################################### + ! -- CMF_DRV_INPUT : Set namelist & logfile + ! -- CMF_DRV_INIT : Initialize CaMa-Flood + ! -- CMF_DRV_END : Finalize CaMa-Flood + ! + !#################################################################### + SUBROUTINE CMF_MPI_INIT + IMPLICIT NONE + !================================================ + !*** 0. MPI specific setting + REGIONTHIS=1 + CALL MPI_Init(ierr) + + MPI_COMM_CAMA=MPI_COMM_WORLD + CALL MPI_Comm_size(MPI_COMM_CAMA, Nproc, ierr) + CALL MPI_Comm_rank(MPI_COMM_CAMA, Nid, ierr) + + REGIONALL =Nproc + REGIONTHIS=Nid+1 + + ! For BUGFIX: Check MPI / OpenMPI is working or not. + ! Write to standard output (log file is not opened yet) + !!!!!#ifdef _OPENMP + !!!!!nOMP = omp_get_max_threads(); + !!!!!!$OMP PARALLEL DO + !!!!!DO iOMP=1, nOMP + !!!!! print *, 'MPI: ', REGIONTHIS, REGIONALL, ' OMP: ', omp_get_thread_num(), nOMP + !!!!!ENDDO + !!!!!!$OMP END PARALLEL DO + !!!!!#endif + + END SUBROUTINE CMF_MPI_INIT +!#################################################################### + + + +!#################################################################### + SUBROUTINE CMF_MPI_END + IMPLICIT NONE + integer(KIND=JPIM) :: ierr + !================================================ + CALL MPI_Finalize(ierr) + END SUBROUTINE CMF_MPI_END +!#################################################################### + + +!#################################################################### + SUBROUTINE CMF_MPI_AllReduce_R2MAP(R2MAP) + USE YOS_CMF_INPUT, only: NX,NY + IMPLICIT NONE + !* input/output + real(KIND=JPRM),intent(inout) :: R2MAP(NX,NY) + !* local variable + real(KIND=JPRM) :: R2TMP(NX,NY) + !================================================ + ! gather to master node + R2TMP(:,:)=1.E30 + CALL MPI_AllReduce(R2MAP,R2TMP,NX*NY,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) + R2MAP(:,:)=R2TMP(:,:) + END SUBROUTINE CMF_MPI_AllReduce_R2MAP + !#################################################################### + + + + + !#################################################################### + SUBROUTINE CMF_MPI_AllReduce_R1PTH(R1PTH) + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV + IMPLICIT NONE + !* input/output + real(KIND=JPRM),intent(inout) :: R1PTH(NPTHOUT,NPTHLEV) + !* local variable + real(KIND=JPRM) :: R1PTMP(NPTHOUT,NPTHLEV) + !================================================ + ! gather to master node + R1PTMP(:,:)=1.E30 + CALL MPI_AllReduce(R1PTH,R1PTMP,NPTHOUT*NPTHLEV,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) + R1PTH(:,:)=R1PTMP(:,:) + END SUBROUTINE CMF_MPI_AllReduce_R1PTH + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_MPI_AllReduce_D2MAP(D2MAP) + ! only used in netCDF restart file. (cannot be compiled due to a bug in MacOS mpif90) + USE YOS_CMF_INPUT, only: NX,NY + IMPLICIT NONE + !* input/output + real(KIND=JPRB),intent(inout) :: D2MAP(NX,NY) + !* local variable + real(KIND=JPRB) :: D2TMP(NX,NY) + !================================================ + ! gather to master node + D2TMP(:,:)=1.E30 #ifdef SinglePrec_CMF - CALL MPI_AllReduce(D2MAP,D2TMP,NX*NY,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) + CALL MPI_AllReduce(D2MAP,D2TMP,NX*NY,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) #else - CALL MPI_AllReduce(D2MAP,D2TMP,NX*NY,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) + CALL MPI_AllReduce(D2MAP,D2TMP,NX*NY,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) #endif - D2MAP(:,:)=D2TMP(:,:) -END SUBROUTINE CMF_MPI_AllReduce_D2MAP -!#################################################################### - - - -!#################################################################### -SUBROUTINE CMF_MPI_AllReduce_P2MAP(P2MAP) -! only used in netCDF restart file. (cannot be compiled due to a bug in MacOS mpif90) -USE YOS_CMF_INPUT, ONLY: NX,NY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRD),INTENT(INOUT) :: P2MAP(NX,NY) -!* local variable -REAL(KIND=JPRD) :: P2TMP(NX,NY) -!================================================ -! gather to master node - P2TMP(:,:)=1.E30 - CALL MPI_AllReduce(P2MAP,P2TMP,NX*NY,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) - P2MAP(:,:)=P2TMP(:,:) -END SUBROUTINE CMF_MPI_AllReduce_P2MAP -!#################################################################### - - - - -!#################################################################### -SUBROUTINE CMF_MPI_AllReduce_D1PTH(D1PTH) -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN -IMPLICIT NONE -!* input/output -REAL(KIND=JPRB),INTENT(INOUT) :: D1PTH(NPTHOUT,NPTHLEV) -!* local variable -REAL(KIND=JPRB) :: D1PTMP(NPTHOUT,NPTHLEV) -INTEGER(KIND=JPIM) :: IPTH -!================================================ -! gather to master node - DO IPTH=1,NPTHOUT - IF (PTH_UPST(IPTH)<=0 .OR. PTH_DOWN(IPTH)<=0 ) THEN - D1PTH(IPTH,:)=1.E20 - ENDIF - END DO - D1PTMP(:,:)=1.E30 + D2MAP(:,:)=D2TMP(:,:) + END SUBROUTINE CMF_MPI_AllReduce_D2MAP + !#################################################################### + + + + !#################################################################### + SUBROUTINE CMF_MPI_AllReduce_P2MAP(P2MAP) + ! only used in netCDF restart file. (cannot be compiled due to a bug in MacOS mpif90) + USE YOS_CMF_INPUT, only: NX,NY + IMPLICIT NONE + !* input/output + real(KIND=JPRD),intent(inout) :: P2MAP(NX,NY) + !* local variable + real(KIND=JPRD) :: P2TMP(NX,NY) + !================================================ + ! gather to master node + P2TMP(:,:)=1.E30 + CALL MPI_AllReduce(P2MAP,P2TMP,NX*NY,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) + P2MAP(:,:)=P2TMP(:,:) + END SUBROUTINE CMF_MPI_AllReduce_P2MAP + !#################################################################### + + + + + !#################################################################### + SUBROUTINE CMF_MPI_AllReduce_D1PTH(D1PTH) + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN + IMPLICIT NONE + !* input/output + real(KIND=JPRB),intent(inout) :: D1PTH(NPTHOUT,NPTHLEV) + !* local variable + real(KIND=JPRB) :: D1PTMP(NPTHOUT,NPTHLEV) + integer(KIND=JPIM) :: IPTH + !================================================ + ! gather to master node + DO IPTH=1,NPTHOUT + IF (PTH_UPST(IPTH)<=0 .or. PTH_DOWN(IPTH)<=0 ) THEN + D1PTH(IPTH,:)=1.E20 + ENDIF + ENDDO + D1PTMP(:,:)=1.E30 #ifdef SinglePrec_CMF -!! CALL MPI_Reduce(D1PTH,D1PTMP,NPTHOUT*NPTHLEV,MPI_REAL4,MPI_MIN,0,MPI_COMM_CAMA,ierr) - CALL MPI_AllReduce(D1PTH,D1PTMP,NPTHOUT*NPTHLEV,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) + !! CALL MPI_Reduce(D1PTH,D1PTMP,NPTHOUT*NPTHLEV,MPI_REAL4,MPI_MIN,0,MPI_COMM_CAMA,ierr) + CALL MPI_AllReduce(D1PTH,D1PTMP,NPTHOUT*NPTHLEV,MPI_REAL4,MPI_MIN,MPI_COMM_CAMA,ierr) #else - CALL MPI_AllReduce(D1PTH,D1PTMP,NPTHOUT*NPTHLEV,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) + CALL MPI_AllReduce(D1PTH,D1PTMP,NPTHOUT*NPTHLEV,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) #endif - D1PTH(:,:)=D1PTMP(:,:) -END SUBROUTINE CMF_MPI_AllReduce_D1PTH -!#################################################################### - - -!#################################################################### -SUBROUTINE CMF_MPI_AllReduce_P1PTH(P1PTH) -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN -IMPLICIT NONE -!* input/output -REAL(KIND=JPRD),INTENT(INOUT) :: P1PTH(NPTHOUT,NPTHLEV) -!* local variable -REAL(KIND=JPRD) :: P1PTMP(NPTHOUT,NPTHLEV) -INTEGER(KIND=JPIM) :: IPTH -!================================================ -! gather to master node - DO IPTH=1,NPTHOUT - IF (PTH_UPST(IPTH)<=0 .OR. PTH_DOWN(IPTH)<=0 ) THEN - P1PTH(IPTH,:)=1.E20 - ENDIF - END DO - P1PTMP(:,:)=1.E30 - CALL MPI_AllReduce(P1PTH,P1PTMP,NPTHOUT*NPTHLEV,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) - P1PTH(:,:)=P1PTMP(:,:) -END SUBROUTINE CMF_MPI_AllReduce_P1PTH -!#################################################################### - - - -!#################################################################### -SUBROUTINE CMF_MPI_ADPSTP(DT_MIN) -USE YOS_CMF_INPUT, ONLY: LOGNAM -IMPLICIT NONE -!* input/output -REAL(KIND=JPRB),INTENT(INOUT) :: DT_MIN -!* local variable -REAL(KIND=JPRD) :: DT_LOC, DT_OUT -!================================================ -!*** MPI: use same DT in all node -DT_LOC=DT_MIN - -CALL MPI_AllReduce(DT_LOC, DT_OUT, 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_CAMA,ierr) -DT_MIN=DT_OUT -WRITE(LOGNAM,'(A,2F10.2)') "ADPSTP (MPI_AllReduce): DT_LOC->DTMIN", DT_LOC, DT_MIN - -END SUBROUTINE CMF_MPI_ADPSTP + D1PTH(:,:)=D1PTMP(:,:) + END SUBROUTINE CMF_MPI_AllReduce_D1PTH + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_MPI_AllReduce_P1PTH(P1PTH) + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN + IMPLICIT NONE + !* input/output + real(KIND=JPRD),intent(inout) :: P1PTH(NPTHOUT,NPTHLEV) + !* local variable + real(KIND=JPRD) :: P1PTMP(NPTHOUT,NPTHLEV) + integer(KIND=JPIM) :: IPTH + !================================================ + ! gather to master node + DO IPTH=1,NPTHOUT + IF (PTH_UPST(IPTH)<=0 .or. PTH_DOWN(IPTH)<=0 ) THEN + P1PTH(IPTH,:)=1.E20 + ENDIF + ENDDO + P1PTMP(:,:)=1.E30 + CALL MPI_AllReduce(P1PTH,P1PTMP,NPTHOUT*NPTHLEV,MPI_REAL8,MPI_MIN,MPI_COMM_CAMA,ierr) + P1PTH(:,:)=P1PTMP(:,:) + END SUBROUTINE CMF_MPI_AllReduce_P1PTH + !#################################################################### + + + +!#################################################################### + SUBROUTINE CMF_MPI_ADPSTP(DT_MIN) + USE YOS_CMF_INPUT, only: LOGNAM + IMPLICIT NONE + !* input/output + real(KIND=JPRB),intent(inout) :: DT_MIN + !* local variable + real(KIND=JPRD) :: DT_LOC, DT_OUT + !================================================ + !*** MPI: use same DT in all node + DT_LOC=DT_MIN + + CALL MPI_AllReduce(DT_LOC, DT_OUT, 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_CAMA,ierr) + DT_MIN=DT_OUT + write(LOGNAM,'(A,2F10.2)') "ADPSTP (MPI_AllReduce): DT_LOC->DTMIN", DT_LOC, DT_MIN + + END SUBROUTINE CMF_MPI_ADPSTP !#################################################################### #endif diff --git a/CaMa/src/cmf_ctrl_nmlist_mod.F90 b/CaMa/src/cmf_ctrl_nmlist_mod.F90 index 1a0d8973..77e703e1 100755 --- a/CaMa/src/cmf_ctrl_nmlist_mod.F90 +++ b/CaMa/src/cmf_ctrl_nmlist_mod.F90 @@ -20,341 +20,337 @@ MODULE CMF_CTRL_NMLIST_MOD ! See the License for the specific language governing permissions and limitations under the License. !========================================================== ! shared variables in module -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM -USE YOS_CMF_MAP, ONLY: REGIONTHIS, REGIONALL + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM + USE YOS_CMF_MAP, only: REGIONTHIS, REGIONALL -IMPLICIT NONE + IMPLICIT NONE CONTAINS -!#################################################################### -! -- CMF_CONFIG_NAMELIST : read namelist for CaMa-Flood -! -- CMF_CONFIG_CHECK : check config conflict -! -!#################################################################### -SUBROUTINE CMF_CONFIG_NMLIST -USE YOS_CMF_INPUT, ONLY: TMPNAM, NSETFILE, CSETFILE -! run version -USE YOS_CMF_INPUT, ONLY: LADPSTP, LFPLAIN, LKINE, LFLDOUT, LPTHOUT, LDAMOUT, & - & LROSPLIT, LGDWDLY, LSLPMIX, LMEANSL, LSEALEV, LOUTPUT, & - & LRESTART, LSTOONLY, LGRIDMAP, LLEAPYR, LMAPEND, LBITSAFE, & - & LSTG_ES, LLEVEE, LOUTINS, LOUTINI, LSEDOUT, & - & LSLOPEMOUTH,LWEVAP,LWINFILT, LWEVAPFIX,LWINFILTFIX,LWEXTRACTRIV -! dimention & time -USE YOS_CMF_INPUT, ONLY: CDIMINFO, DT, NX,NY, NLFP, NXIN,NYIN, INPN, & - & IFRQ_INP, DTIN, WEST,EAST,NORTH,SOUTH -! parameters -USE YOS_CMF_INPUT, ONLY: PMANRIV, PMANFLD, PDSTMTH, PMINSLP, PGRV, PCADP, & - & IMIS, RMIS, DMIS, CSUFBIN, CSUFVEC, CSUFPTH, CSUFCDF -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!* local -CHARACTER(LEN=8) :: CREG !! -! -NAMELIST/NRUNVER/ LADPSTP, LFPLAIN, LKINE, LFLDOUT, LPTHOUT, LDAMOUT, & - LROSPLIT, LGDWDLY, LSLPMIX, LMEANSL, LSEALEV, LOUTPUT, & - LRESTART, LSTOONLY, LGRIDMAP, LLEAPYR, LMAPEND, LBITSAFE, & - LSTG_ES, LLEVEE, LSEDOUT, LOUTINS, LSLOPEMOUTH, & - LWEVAP, LWINFILT, LWEVAPFIX,LWINFILTFIX,LWEXTRACTRIV, LOUTINI - -NAMELIST/NDIMTIME/ CDIMINFO, DT, IFRQ_INP - -NAMELIST/NPARAM/ PMANRIV, PMANFLD, PGRV, PDSTMTH, PCADP, PMINSLP, & - IMIS, RMIS, DMIS, CSUFBIN, CSUFVEC, CSUFPTH, CSUFCDF -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!--------------------" - -! *** 0. SET INPUT UNIT AND OPEN FILE -NSETFILE=INQUIRE_FID() !! for namelist -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::CONFIG_NMLIST: namelist opened: ", TRIM(CSETFILE), NSETFILE - -!============================ -!*** 1. basic simulation run version - -! * defaults -LADPSTP = .TRUE. !! true: use adaptive time step -LFPLAIN = .TRUE. !! true: consider floodplain (false: only river channel) -LKINE = .FALSE. !! true: use kinematic wave -LFLDOUT = .TRUE. !! true: floodplain flow (high-water channel flow) active -LPTHOUT = .FALSE. !! true: activate bifurcation scheme -LDAMOUT = .FALSE. !! true: activate dam operation (under development) -LLEVEE = .FALSE. !! true: activate levee scheme (under development) -LSEDOUT = .FALSE. !! true: activate sediment transport (under development) -LOUTINS = .FALSE. !! true: diagnose instantaneous discharge -!!=== this part is used by ECMWF -LROSPLIT = .FALSE. !! true: input if surface (Qs) and sub-surface (Qsb) runoff -LWEVAP = .FALSE. !! true: input evaporation to extract from river -LWINFILT = .FALSE. !! true: input infiltration to extract from river -LWEVAPFIX= .FALSE. !! true: water balance closure extracting water from evap when available -LWINFILTFIX= .FALSE. !! true: water balance closure extracting water from infiltration when available -LGDWDLY = .FALSE. !! true: Activate ground water reservoir and delay -LSLPMIX = .FALSE. !! true: activate mixed kinematic and local inertia based on slope -LWEXTRACTRIV=.FALSE. !! true: also extract water from rivers -LSLOPEMOUTH =.FALSE. !! true: prescribe water level slope == elevation slope on river month -!!=== - -!! dinamic sea level -LMEANSL = .FALSE. !! true : boundary condition for mean sea level -LSEALEV = .FALSE. !! true : boundary condition for variable sea level - -!! restaer & output -LRESTART = .FALSE. !! true: initial condition from restart file -LSTOONLY = .FALSE. !! true: storage only restart (mainly for data assimilation) -LOUTPUT = .TRUE. !! true: use standard output (to file) -LOUTINI = .FALSE. !! true: output initial storage (netCDF only) - -LGRIDMAP = .TRUE. !! true: for standard XY gridded 2D map -LLEAPYR = .FALSE. !! true: neglect leap year (Feb29 skipped) -LMAPEND = .FALSE. !! true: for map data endian conversion -LBITSAFE = .FALSE. !! true: for Bit Identical (not used from v410, set in Mkinclude) -LSTG_ES = .FALSE. !! true: for Vector Processor optimization (CMF_OPT_FLDSTG_ES) - -!* change -REWIND(NSETFILE) -READ(NSETFILE,NML=NRUNVER) - -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "=== NAMELIST, NRUNVER ===" -WRITE(LOGNAM,*) "LADPSTP ", LADPSTP -WRITE(LOGNAM,*) "LFPLAIN ", LFPLAIN -WRITE(LOGNAM,*) "LKINE ", LKINE -WRITE(LOGNAM,*) "LFLDOUT ", LFLDOUT -WRITE(LOGNAM,*) "LPTHOUT ", LPTHOUT -WRITE(LOGNAM,*) "LDAMOUT ", LDAMOUT -WRITE(LOGNAM,*) "LLEVEE ", LLEVEE -WRITE(LOGNAM,*) "LSEDOUT ", LSEDOUT -WRITE(LOGNAM,*) "LOUTINS ", LOUTINS -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "LROSPLIT ", LROSPLIT -WRITE(LOGNAM,*) "LWEVAP ", LWEVAP -WRITE(LOGNAM,*) "LWEVAPFIX", LWEVAPFIX -WRITE(LOGNAM,*) "LWINFILT ", LWINFILT -WRITE(LOGNAM,*) "LWINFILTFIX", LWINFILTFIX -WRITE(LOGNAM,*) "LWEXTRACTRIV", LWEXTRACTRIV -WRITE(LOGNAM,*) "LGDWDLY ", LGDWDLY -WRITE(LOGNAM,*) "LSLPMIX ", LSLPMIX -WRITE(LOGNAM,*) "LSLOPEMOUTH ", LSLOPEMOUTH -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "LMEANSL: ", LSEALEV -WRITE(LOGNAM,*) "LSEALEV: ", LSEALEV -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "LRESTART ", LRESTART -WRITE(LOGNAM,*) "LSTOONLY ", LSTOONLY -WRITE(LOGNAM,*) "LOUTPUT ", LOUTPUT -WRITE(LOGNAM,*) "LOUTINI ", LOUTINI -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "LGRIDMAP ", LGRIDMAP -WRITE(LOGNAM,*) "LLEAPYR ", LLEAPYR -WRITE(LOGNAM,*) "LMAPEND ", LMAPEND -WRITE(LOGNAM,*) "LBITSAFE ", LBITSAFE -WRITE(LOGNAM,*) "LSTG_ES " , LSTG_ES - -!============================ -!*** 2. set model dimention & time - -!* defaults (from namelist) -CDIMINFO ="NONE" -DT = 24*60*60 !! dt = 1day (automatically set by adaptive time step) -IFRQ_INP = 24 !! daily (24h) input - -!* change -REWIND(NSETFILE) -READ(NSETFILE,NML=NDIMTIME) - -DTIN = IFRQ_INP*60*60 !! hour -> second - -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "=== NAMELIST, NCONF ===" -WRITE(LOGNAM,*) "CDIMINFO ", TRIM(CDIMINFO) -WRITE(LOGNAM,*) "DT ", DT -WRITE(LOGNAM,*) "DTIN ", DTIN -WRITE(LOGNAM,*) "IFRQ_INP ", IFRQ_INP - -!========== -!* default (from diminfo) -NX = 1440 !! 15 minute resolution -NY = 720 -NLFP = 10 !! 10 floodplain layer -NXIN = 360 !! 1 degree input -NYIN = 180 -INPN = 1 !! maximum number of input grids corresponding to one CaMa-Flood grid -WEST = -180._JPRB !! west, east, north, south edges of the domain -EAST = 180._JPRB -NORTH = 90._JPRB -SOUTH = -90._JPRB - -!* value from CDIMINFO -IF( CDIMINFO/="NONE" )THEN - WRITE(LOGNAM,*) "CMF::CONFIG_NMLIST: read DIMINFO ", TRIM(CDIMINFO) - - TMPNAM=INQUIRE_FID() - OPEN(TMPNAM,FILE=CDIMINFO,FORM='FORMATTED') - READ(TMPNAM,*) NX - READ(TMPNAM,*) NY - READ(TMPNAM,*) NLFP - READ(TMPNAM,*) NXIN - READ(TMPNAM,*) NYIN - READ(TMPNAM,*) INPN - READ(TMPNAM,*) - IF( LGRIDMAP )THEN - READ(TMPNAM,*) WEST - READ(TMPNAM,*) EAST - READ(TMPNAM,*) NORTH - READ(TMPNAM,*) SOUTH - ENDIF - CLOSE(TMPNAM) -ENDIF - -!* check -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "=== DIMINFO ===" -WRITE(LOGNAM,*) "NX,NY,NLFP ", NX, NY, NLFP -WRITE(LOGNAM,*) "NXIN,NYIN,INPN ", NXIN,NYIN,INPN -IF( LGRIDMAP ) THEN - WRITE(LOGNAM,*) "WEST,EAST,NORTH,SOUTH ", WEST,EAST,NORTH,SOUTH -ENDIF - -!============================ -!*** 3. set PARAM: parameters -! * defaults -PMANRIV=0.03_JPRB !! manning coefficient river -PMANFLD=0.10_JPRB !! manning coefficient floodplain -PGRV =9.8_JPRB !! gravity accerelation -PDSTMTH=10000._JPRB !! downstream distance at river mouth [m] -PCADP =0.7_JPRB !! CFL coefficient -PMINSLP=1.E-5 !! minimum slope (kinematic wave) - -IMIS=-9999_JPIM -RMIS=1.E20_JPRM -DMIS=1.E20_JPRB - -CSUFBIN='.bin' -CSUFVEC='.vec' -CSUFPTH='.pth' -CSUFCDF='.nc' - -! * change -REWIND(NSETFILE) -READ(NSETFILE,NML=NPARAM) - -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "=== NAMELIST, NPARAM ===" -WRITE(LOGNAM,*) "PMANRIV ", PMANRIV -WRITE(LOGNAM,*) "PMANRIV ", PMANFLD -WRITE(LOGNAM,*) "PGRV ", PGRV -WRITE(LOGNAM,*) "PDSTMTH ", PDSTMTH -WRITE(LOGNAM,*) "PCADP ", PCADP -WRITE(LOGNAM,*) "PMINSLP ", PMINSLP -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "IMIS ", IMIS -WRITE(LOGNAM,*) "RMIS ", RMIS -WRITE(LOGNAM,*) "DMIS ", DMIS -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "CSUFBIN ", TRIM(CSUFBIN) -WRITE(LOGNAM,*) "CSUFVEC ", TRIM(CSUFVEC) -WRITE(LOGNAM,*) "CSUFPTH ", TRIM(CSUFPTH) -WRITE(LOGNAM,*) "CSUFCDF ", TRIM(CSUFCDF) - -!=============================== -!*** CLOSE FILE -CLOSE(NSETFILE) - -WRITE(LOGNAM,*) "CMF::CONFIG_NMLIST: end " - -WRITE(LOGNAM,*) "--------------------!" -WRITE(LOGNAM,*) "" - -IF (REGIONALL>=2 )then - WRITE(CREG,'(I0)') REGIONTHIS !! Regional Output for MPI run - CSUFVEC=TRIM(CSUFVEC)//'-'//TRIM(CREG) !! Change suffix of output file for each MPI node (only vector output) -ENDIF - - -END SUBROUTINE CMF_CONFIG_NMLIST -!#################################################################### - - - - -!#################################################################### -SUBROUTINE CMF_CONFIG_CHECK -USE YOS_CMF_INPUT, ONLY: LADPSTP, LFPLAIN, LKINE, LPTHOUT, & - & LROSPLIT, LGDWDLY, LSEALEV, & - & LWEVAP, LWEVAPFIX, LWINFILT, LWINFILTFIX, LWEXTRACTRIV -USE YOS_CMF_INPUT, ONLY: DT, DTIN, DTSL -IMPLICIT NONE -!================================================ - -WRITE(LOGNAM,*) "CMF::CONFIG_CHECK: check setting conflicts" - -!*** 1. check for time step -IF ( DT<60 .or. MOD( INT(DT),60 )/=0 ) THEN - WRITE(LOGNAM,*) "DT= ", DT - WRITE(LOGNAM,*) "DT should be multiple of 60. CaMa-Flood controls time by MINUTE" - WRITE(LOGNAM,*) "stop" - STOP 9 -ENDIF - -IF ( MOD( INT(DTIN), INT(DT) )/=0 ) THEN - WRITE(LOGNAM,*) "DTIN, DT= ", DTIN, DT - WRITE(LOGNAM,*) "DTIN should be multiple of DT" - WRITE(LOGNAM,*) "stop" - STOP 9 -ENDIF - -IF ( LSEALEV .and. MOD( INT(DTSL), INT(DT) )/=0 ) THEN - WRITE(LOGNAM,*) "DTSL, DT= ", DTIN, DT - WRITE(LOGNAM,*) "DTSL should be multiple of DT" - WRITE(LOGNAM,*) "stop" - STOP 9 -ENDIF - -!*** 2. check for physics options - -IF ( .not.LFPLAIN .AND. .not.LKINE ) THEN - WRITE(LOGNAM,*) "LFPLAIN=.false. & LKINE=.false." - WRITE(LOGNAM,*) "CAUTION: NO FLOODPLAIN OPTION reccomended to be used with kinematic wave (LKINE=.true.)" -ENDIF - -IF ( LKINE .AND. LADPSTP ) THEN - WRITE(LOGNAM,*) "LKINE=.true. & LADPSTP=.true." - WRITE(LOGNAM,*) "adaptive time step reccoomended only with local inertial equation (LKINE=.false.)" - WRITE(LOGNAM,*) "Set appropriate fixed time step for Kinematic Wave" -ENDIF - -IF ( LKINE .AND. LPTHOUT ) THEN - WRITE(LOGNAM,*) "LKINE=.true. & LPATHOUT=.true." - WRITE(LOGNAM,*) "bifurcation channel flow only available with local inertial equation (LKINE=.false.)" - WRITE(LOGNAM,*) "STOP" - STOP 9 -ENDIF - -IF ( LGDWDLY .AND. .NOT. LROSPLIT ) THEN - WRITE(LOGNAM,*) "LGDWDLY=true and LROSPLIT=false" - WRITE(LOGNAM,*) "Ground water reservoir can only be active when runoff splitting is on" -ENDIF - -IF ( LWEVAPFIX .AND. .NOT. LWEVAP ) THEN - WRITE(LOGNAM,*) "LWEVAPFIX=true and LWEVAP=false" - WRITE(LOGNAM,*) "LWEVAPFIX can only be active if LWEVAP is active" -ENDIF - -! add water re-infiltration calculation -IF ( LWINFILTFIX .AND. .NOT. LWINFILT ) THEN - WRITE(LOGNAM,*) "LWINFILTFIX=true and LWINFILT=false" - WRITE(LOGNAM,*) "LWINFILTFIX can only be active if LWINFILT is active" -ENDIF - -IF ( LWEXTRACTRIV .AND. .NOT. LWEVAP ) THEN - WRITE(LOGNAM,*) "LWEXTRACTRIV=true and LWEVAP=false" - WRITE(LOGNAM,*) "LWEXTRACTRIV can only be active if LWEVAP is active" -ENDIF - - -WRITE(LOGNAM,*) "CMF::CONFIG_CHECK: end" - -END SUBROUTINE CMF_CONFIG_CHECK + !#################################################################### + ! -- CMF_CONFIG_NAMELIST : read namelist for CaMa-Flood + ! -- CMF_CONFIG_CHECK : check config conflict + ! + !#################################################################### + SUBROUTINE CMF_CONFIG_NMLIST + USE YOS_CMF_INPUT, only: TMPNAM, NSETFILE, CSETFILE + ! run version + USE YOS_CMF_INPUT, only: LADPSTP, LFPLAIN, LKINE, LFLDOUT, LPTHOUT, LDAMOUT, & + & LROSPLIT, LGDWDLY, LSLPMIX, LMEANSL, LSEALEV, LOUTPUT, & + & LRESTART, LSTOONLY, LGRIDMAP, LLEAPYR, LMAPEND, LBITSAFE, & + & LSTG_ES, LLEVEE, LOUTINS, LOUTINI, LSEDOUT, & + & LSLOPEMOUTH,LWEVAP,LWINFILT, LWEVAPFIX,LWINFILTFIX,LWEXTRACTRIV + ! dimention & time + USE YOS_CMF_INPUT, only: CDIMINFO, DT, NX,NY, NLFP, NXIN,NYIN, INPN, & + & IFRQ_INP, DTIN, WEST,EAST,NORTH,SOUTH + ! parameters + USE YOS_CMF_INPUT, only: PMANRIV, PMANFLD, PDSTMTH, PMINSLP, PGRV, PCADP, & + & IMIS, RMIS, DMIS, CSUFBIN, CSUFVEC, CSUFPTH, CSUFCDF + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !* local + character(LEN=8) :: CREG !! + ! + NAMELIST/NRUNVER/ LADPSTP, LFPLAIN, LKINE, LFLDOUT, LPTHOUT, LDAMOUT, & + LROSPLIT, LGDWDLY, LSLPMIX, LMEANSL, LSEALEV, LOUTPUT, & + LRESTART, LSTOONLY, LGRIDMAP, LLEAPYR, LMAPEND, LBITSAFE, & + LSTG_ES, LLEVEE, LSEDOUT, LOUTINS, LSLOPEMOUTH, & + LWEVAP, LWINFILT, LWEVAPFIX,LWINFILTFIX,LWEXTRACTRIV, LOUTINI + + NAMELIST/NDIMTIME/ CDIMINFO, DT, IFRQ_INP + + NAMELIST/NPARAM/ PMANRIV, PMANFLD, PGRV, PDSTMTH, PCADP, PMINSLP, & + IMIS, RMIS, DMIS, CSUFBIN, CSUFVEC, CSUFPTH, CSUFCDF + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!--------------------" + + ! *** 0. SET INPUT UNIT AND open FILE + NSETFILE=INQUIRE_FID() !! for namelist + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::CONFIG_NMLIST: namelist opened: ", TRIM(CSETFILE), NSETFILE + + !============================ + !*** 1. basic simulation run version + + ! * defaults + LADPSTP = .TRUE. !! true: use adaptive time step + LFPLAIN = .TRUE. !! true: consider floodplain (false: only river channel) + LKINE = .FALSE. !! true: use kinematic wave + LFLDOUT = .TRUE. !! true: floodplain flow (high-water channel flow) active + LPTHOUT = .FALSE. !! true: activate bifurcation scheme + LDAMOUT = .FALSE. !! true: activate dam operation (under development) + LLEVEE = .FALSE. !! true: activate levee scheme (under development) + LSEDOUT = .FALSE. !! true: activate sediment transport (under development) + LOUTINS = .FALSE. !! true: diagnose instantaneous discharge + !!=== this part is used by ECMWF + LROSPLIT = .FALSE. !! true: input if surface (Qs) and sub-surface (Qsb) runoff + LWEVAP = .FALSE. !! true: input evaporation to extract from river + LWINFILT = .FALSE. !! true: input infiltration to extract from river + LWEVAPFIX= .FALSE. !! true: water balance closure extracting water from evap when available + LWINFILTFIX= .FALSE. !! true: water balance closure extracting water from infiltration when available + LGDWDLY = .FALSE. !! true: Activate ground water reservoir and delay + LSLPMIX = .FALSE. !! true: activate mixed kinematic and local inertia based on slope + LWEXTRACTRIV=.FALSE. !! true: also extract water from rivers + LSLOPEMOUTH =.FALSE. !! true: prescribe water level slope == elevation slope on river month + !!=== + + !! dinamic sea level + LMEANSL = .FALSE. !! true : boundary condition for mean sea level + LSEALEV = .FALSE. !! true : boundary condition for variable sea level + + !! restaer & output + LRESTART = .FALSE. !! true: initial condition from restart file + LSTOONLY = .FALSE. !! true: storage only restart (mainly for data assimilation) + LOUTPUT = .TRUE. !! true: use standard output (to file) + LOUTINI = .FALSE. !! true: output initial storage (netCDF only) + + LGRIDMAP = .TRUE. !! true: for standard XY gridded 2D map + LLEAPYR = .FALSE. !! true: neglect leap year (Feb29 skipped) + LMAPEND = .FALSE. !! true: for map data endian conversion + LBITSAFE = .FALSE. !! true: for Bit Identical (not used from v410, set in Mkinclude) + LSTG_ES = .FALSE. !! true: for Vector Processor optimization (CMF_OPT_FLDSTG_ES) + + !* change + rewind(NSETFILE) + read(NSETFILE,NML=NRUNVER) + + write(LOGNAM,*) "" + write(LOGNAM,*) "=== NAMELIST, NRUNVER ===" + write(LOGNAM,*) "LADPSTP ", LADPSTP + write(LOGNAM,*) "LFPLAIN ", LFPLAIN + write(LOGNAM,*) "LKINE ", LKINE + write(LOGNAM,*) "LFLDOUT ", LFLDOUT + write(LOGNAM,*) "LPTHOUT ", LPTHOUT + write(LOGNAM,*) "LDAMOUT ", LDAMOUT + write(LOGNAM,*) "LLEVEE ", LLEVEE + write(LOGNAM,*) "LSEDOUT ", LSEDOUT + write(LOGNAM,*) "LOUTINS ", LOUTINS + write(LOGNAM,*) "" + write(LOGNAM,*) "LROSPLIT ", LROSPLIT + write(LOGNAM,*) "LWEVAP ", LWEVAP + write(LOGNAM,*) "LWEVAPFIX", LWEVAPFIX + write(LOGNAM,*) "LWINFILT ", LWINFILT + write(LOGNAM,*) "LWINFILTFIX", LWINFILTFIX + write(LOGNAM,*) "LWEXTRACTRIV", LWEXTRACTRIV + write(LOGNAM,*) "LGDWDLY ", LGDWDLY + write(LOGNAM,*) "LSLPMIX ", LSLPMIX + write(LOGNAM,*) "LSLOPEMOUTH ", LSLOPEMOUTH + write(LOGNAM,*) "" + write(LOGNAM,*) "LMEANSL: ", LSEALEV + write(LOGNAM,*) "LSEALEV: ", LSEALEV + write(LOGNAM,*) "" + write(LOGNAM,*) "LRESTART ", LRESTART + write(LOGNAM,*) "LSTOONLY ", LSTOONLY + write(LOGNAM,*) "LOUTPUT ", LOUTPUT + write(LOGNAM,*) "LOUTINI ", LOUTINI + write(LOGNAM,*) "" + write(LOGNAM,*) "LGRIDMAP ", LGRIDMAP + write(LOGNAM,*) "LLEAPYR ", LLEAPYR + write(LOGNAM,*) "LMAPEND ", LMAPEND + write(LOGNAM,*) "LBITSAFE ", LBITSAFE + write(LOGNAM,*) "LSTG_ES " , LSTG_ES + + !============================ + !*** 2. set model dimention & time + + !* defaults (from namelist) + CDIMINFO ="NONE" + DT = 24*60*60 !! dt = 1day (automatically set by adaptive time step) + IFRQ_INP = 24 !! daily (24h) input + + !* change + rewind(NSETFILE) + read(NSETFILE,NML=NDIMTIME) + + DTIN = IFRQ_INP*60*60 !! hour -> second + + write(LOGNAM,*) "" + write(LOGNAM,*) "=== NAMELIST, NCONF ===" + write(LOGNAM,*) "CDIMINFO ", TRIM(CDIMINFO) + write(LOGNAM,*) "DT ", DT + write(LOGNAM,*) "DTIN ", DTIN + write(LOGNAM,*) "IFRQ_INP ", IFRQ_INP + + !========== + !* default (from diminfo) + NX = 1440 !! 15 minute resolution + NY = 720 + NLFP = 10 !! 10 floodplain layer + NXIN = 360 !! 1 degree input + NYIN = 180 + INPN = 1 !! maximum number of input grids corresponding to one CaMa-Flood grid + WEST = -180._JPRB !! west, east, north, south edges of the domain + EAST = 180._JPRB + NORTH = 90._JPRB + SOUTH = -90._JPRB + + !* value from CDIMINFO + IF( CDIMINFO/="NONE" )THEN + write(LOGNAM,*) "CMF::CONFIG_NMLIST: read DIMINFO ", TRIM(CDIMINFO) + + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CDIMINFO,FORM='FORMATTED') + read(TMPNAM,*) NX + read(TMPNAM,*) NY + read(TMPNAM,*) NLFP + read(TMPNAM,*) NXIN + read(TMPNAM,*) NYIN + read(TMPNAM,*) INPN + read(TMPNAM,*) + IF( LGRIDMAP )THEN + read(TMPNAM,*) WEST + read(TMPNAM,*) EAST + read(TMPNAM,*) NORTH + read(TMPNAM,*) SOUTH + ENDIF + close(TMPNAM) + ENDIF + + !* check + write(LOGNAM,*) "" + write(LOGNAM,*) "=== DIMINFO ===" + write(LOGNAM,*) "NX,NY,NLFP ", NX, NY, NLFP + write(LOGNAM,*) "NXIN,NYIN,INPN ", NXIN,NYIN,INPN + IF( LGRIDMAP ) THEN + write(LOGNAM,*) "WEST,EAST,NORTH,SOUTH ", WEST,EAST,NORTH,SOUTH + ENDIF + + !============================ + !*** 3. set PARAM: parameters + ! * defaults + PMANRIV=0.03_JPRB !! manning coefficient river + PMANFLD=0.10_JPRB !! manning coefficient floodplain + PGRV =9.8_JPRB !! gravity accerelation + PDSTMTH=10000._JPRB !! downstream distance at river mouth [m] + PCADP =0.7_JPRB !! CFL coefficient + PMINSLP=1.E-5 !! minimum slope (kinematic wave) + + IMIS=-9999_JPIM + RMIS=1.E20_JPRM + DMIS=1.E20_JPRB + + CSUFBIN='.bin' + CSUFVEC='.vec' + CSUFPTH='.pth' + CSUFCDF='.nc' + + ! * change + rewind(NSETFILE) + read(NSETFILE,NML=NPARAM) + + write(LOGNAM,*) "" + write(LOGNAM,*) "=== NAMELIST, NPARAM ===" + write(LOGNAM,*) "PMANRIV ", PMANRIV + write(LOGNAM,*) "PMANRIV ", PMANFLD + write(LOGNAM,*) "PGRV ", PGRV + write(LOGNAM,*) "PDSTMTH ", PDSTMTH + write(LOGNAM,*) "PCADP ", PCADP + write(LOGNAM,*) "PMINSLP ", PMINSLP + write(LOGNAM,*) "" + write(LOGNAM,*) "IMIS ", IMIS + write(LOGNAM,*) "RMIS ", RMIS + write(LOGNAM,*) "DMIS ", DMIS + write(LOGNAM,*) "" + write(LOGNAM,*) "CSUFBIN ", TRIM(CSUFBIN) + write(LOGNAM,*) "CSUFVEC ", TRIM(CSUFVEC) + write(LOGNAM,*) "CSUFPTH ", TRIM(CSUFPTH) + write(LOGNAM,*) "CSUFCDF ", TRIM(CSUFCDF) + + !=============================== + !*** close FILE + close(NSETFILE) + + write(LOGNAM,*) "CMF::CONFIG_NMLIST: end " + + write(LOGNAM,*) "--------------------!" + write(LOGNAM,*) "" + + IF (REGIONALL>=2 )THEN + write(CREG,'(I0)') REGIONTHIS !! Regional Output for MPI run + CSUFVEC=TRIM(CSUFVEC)//'-'//TRIM(CREG) !! Change suffix of output file for each MPI node (only vector output) + ENDIF + + END SUBROUTINE CMF_CONFIG_NMLIST + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_CONFIG_CHECK + USE YOS_CMF_INPUT, only: LADPSTP, LFPLAIN, LKINE, LPTHOUT, & + & LROSPLIT, LGDWDLY, LSEALEV, & + & LWEVAP, LWEVAPFIX, LWINFILT, LWINFILTFIX, LWEXTRACTRIV + USE YOS_CMF_INPUT, only: DT, DTIN, DTSL + IMPLICIT NONE + !================================================ + + write(LOGNAM,*) "CMF::CONFIG_CHECK: check setting conflicts" + + !*** 1. check for time step + IF ( DT<60 .or. MOD( INT(DT),60 )/=0 ) THEN + write(LOGNAM,*) "DT= ", DT + write(LOGNAM,*) "DT should be multiple of 60. CaMa-Flood controls time by MINUTE" + write(LOGNAM,*) "stop" + STOP 9 + ENDIF + + IF ( MOD( INT(DTIN), INT(DT) )/=0 ) THEN + write(LOGNAM,*) "DTIN, DT= ", DTIN, DT + write(LOGNAM,*) "DTIN should be multiple of DT" + write(LOGNAM,*) "stop" + STOP 9 + ENDIF + + IF ( LSEALEV .and. MOD( INT(DTSL), INT(DT) )/=0 ) THEN + write(LOGNAM,*) "DTSL, DT= ", DTIN, DT + write(LOGNAM,*) "DTSL should be multiple of DT" + write(LOGNAM,*) "stop" + STOP 9 + ENDIF + + !*** 2. check for physics options + + IF ( .not.LFPLAIN .and. .not.LKINE ) THEN + write(LOGNAM,*) "LFPLAIN=.false. & LKINE=.false." + write(LOGNAM,*) "CAUTION: NO FLOODPLAIN OPTION reccomended to be used with kinematic wave (LKINE=.true.)" + ENDIF + + IF ( LKINE .and. LADPSTP ) THEN + write(LOGNAM,*) "LKINE=.true. & LADPSTP=.true." + write(LOGNAM,*) "adaptive time step reccoomended only with local inertial equation (LKINE=.false.)" + write(LOGNAM,*) "Set appropriate fixed time step for Kinematic Wave" + ENDIF + + IF ( LKINE .and. LPTHOUT ) THEN + write(LOGNAM,*) "LKINE=.true. & LPATHOUT=.true." + write(LOGNAM,*) "bifurcation channel flow only available with local inertial equation (LKINE=.false.)" + write(LOGNAM,*) "STOP" + STOP 9 + ENDIF + + IF ( LGDWDLY .and. .not. LROSPLIT ) THEN + write(LOGNAM,*) "LGDWDLY=true and LROSPLIT=false" + write(LOGNAM,*) "Ground water reservoir can only be active when runoff splitting is on" + ENDIF + + IF ( LWEVAPFIX .and. .not. LWEVAP ) THEN + write(LOGNAM,*) "LWEVAPFIX=true and LWEVAP=false" + write(LOGNAM,*) "LWEVAPFIX can only be active if LWEVAP is active" + ENDIF + + ! add water re-infiltration calculation + IF ( LWINFILTFIX .and. .not. LWINFILT ) THEN + write(LOGNAM,*) "LWINFILTFIX=true and LWINFILT=false" + write(LOGNAM,*) "LWINFILTFIX can only be active if LWINFILT is active" + ENDIF + + IF ( LWEXTRACTRIV .and. .not. LWEVAP ) THEN + write(LOGNAM,*) "LWEXTRACTRIV=true and LWEVAP=false" + write(LOGNAM,*) "LWEXTRACTRIV can only be active if LWEVAP is active" + ENDIF + + write(LOGNAM,*) "CMF::CONFIG_CHECK: end" + + END SUBROUTINE CMF_CONFIG_CHECK !#################################################################### END MODULE CMF_CTRL_NMLIST_MOD diff --git a/CaMa/src/cmf_ctrl_output_mod.F90 b/CaMa/src/cmf_ctrl_output_mod.F90 index 36f022c6..0ceb6da2 100755 --- a/CaMa/src/cmf_ctrl_output_mod.F90 +++ b/CaMa/src/cmf_ctrl_output_mod.F90 @@ -18,841 +18,814 @@ MODULE CMF_CTRL_OUTPUT_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -! shared variables in module -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM, IFRQ_OUT -USE YOS_CMF_INPUT, ONLY: CSUFBIN, CSUFVEC, CSUFPTH, CSUFCDF -USE YOS_CMF_INPUT, ONLY: LPTHOUT, LDAMOUT, LLEVEE, LWEVAP, LWINFILT,LGDWDLY, LOUTINS,LROSPLIT -IMPLICIT NONE -!============================ -SAVE -!*** NAMELIST/NOUTPUT/ from inputnam -CHARACTER(LEN=256) :: COUTDIR ! OUTPUT DIRECTORY -CHARACTER(LEN=256) :: CVARSOUT ! Comma-separated list of output variables to save -CHARACTER(LEN=256) :: COUTTAG ! Output Tag Name for each experiment -! -LOGICAL :: LOUTVEC ! TRUE FOR VECTORIAL OUTPUT, FALSE FOR NX,NY OUTPUT -LOGICAL :: LOUTCDF ! true for netcdf outptu false for binary -INTEGER(KIND=JPIM) :: NDLEVEL ! NETCDF DEFLATION LEVEL -! -LOGICAL :: LOUTTXT ! TRUE FOR Text output for some gauges -CHARACTER(LEN=256) :: CGAUTXT ! List of Gauges (ID, IX, IY) -! -NAMELIST/NOUTPUT/ COUTDIR,CVARSOUT,COUTTAG,LOUTCDF,NDLEVEL,LOUTVEC,IFRQ_OUT,LOUTTXT,CGAUTXT -! -!*** local variables -INTEGER(KIND=JPIM) :: NVARS ! temporal output var number -PARAMETER (NVARS=30) ! actual output var number -INTEGER(KIND=JPIM) :: NVARSOUT -INTEGER(KIND=JPIM) :: IRECOUT ! Output file irec - -!*** TYPE for output file -TYPE TVAROUT -CHARACTER(LEN=256) :: CVNAME ! output variable name -CHARACTER(LEN=256) :: CVLNAME ! output variable long name -CHARACTER(LEN=256) :: CVUNITS ! output units -CHARACTER(LEN=256) :: CFILE ! output full path file name -INTEGER(KIND=JPIM) :: BINID ! output binary output file ID -INTEGER(KIND=JPIM) :: NCID ! output netCDF output file ID -INTEGER(KIND=JPIM) :: VARID ! output netCDF output variable ID -INTEGER(KIND=JPIM) :: TIMID ! output netCDF time variable ID -INTEGER(KIND=JPIM) :: IRECNC ! Current time record for writting -END TYPE TVAROUT -TYPE(TVAROUT),ALLOCATABLE :: VAROUT(:) ! output variable TYPE set +! shared variables in MODULE + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM, IFRQ_OUT + USE YOS_CMF_INPUT, only: CSUFBIN, CSUFVEC, CSUFPTH, CSUFCDF + USE YOS_CMF_INPUT, only: LPTHOUT, LDAMOUT, LLEVEE, LWEVAP, LWINFILT,LGDWDLY, LOUTINS,LROSPLIT + IMPLICIT NONE + !============================ + SAVE + !*** NAMELIST/NOUTPUT/ from inputnam + character(LEN=256) :: COUTDIR ! OUTPUT DIRECTORY + character(LEN=256) :: CVARSOUT ! Comma-separated list of output variables to save + character(LEN=256) :: COUTTAG ! Output Tag Name for each experiment + ! + logical :: LOUTVEC ! TRUE FOR VECTORIAL OUTPUT, FALSE FOR NX,NY OUTPUT + logical :: LOUTCDF ! true for netcdf outptu false for binary + integer(KIND=JPIM) :: NDLEVEL ! NETCDF DEFLATION LEVEL + ! + logical :: LOUTTXT ! TRUE FOR Text output for some gauges + character(LEN=256) :: CGAUTXT ! List of Gauges (ID, IX, IY) + ! + NAMELIST/NOUTPUT/ COUTDIR,CVARSOUT,COUTTAG,LOUTCDF,NDLEVEL,LOUTVEC,IFRQ_OUT,LOUTTXT,CGAUTXT + ! + !*** local variables + integer(KIND=JPIM) :: NVARS ! temporal output var number + parameter (NVARS=30) ! actual output var number + integer(KIND=JPIM) :: NVARSOUT + integer(KIND=JPIM) :: IRECOUT ! Output file irec + + !*** type for output file + type TVAROUT + character(LEN=256) :: CVNAME ! output variable name + character(LEN=256) :: CVLNAME ! output variable long name + character(LEN=256) :: CVUNITS ! output units + character(LEN=256) :: CFILE ! output full path file name + integer(KIND=JPIM) :: BINID ! output binary output file ID + integer(KIND=JPIM) :: NCID ! output netCDF output file ID + integer(KIND=JPIM) :: VARID ! output netCDF output variable ID + integer(KIND=JPIM) :: TIMID ! output netCDF time variable ID + integer(KIND=JPIM) :: IRECNC ! Current time record for writting + END type TVAROUT + type(TVAROUT),ALLOCATABLE :: VAROUT(:) ! output variable type set CONTAINS -!#################################################################### -! -- CMF_OUTPUT_NMLIST : Read output file info from namelist -! -- CMF_OUTPUT_INIT : Create & Open standard output files -! -- CMF_OUTPUT_WRITE : Write output to files -! -- CMF_OUTPUT_END : Close standard output files -! -- -!#################################################################### -SUBROUTINE CMF_OUTPUT_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 1. open namelist -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::OUTPUT_NMLIST: namelist OPEN in unit:", TRIM(CSETFILE), NSETFILE - -!*** 2. default value -COUTDIR="./" -CVARSOUT="outflw,storge,rivdph" -COUTTAG="_cmf" -LOUTCDF=.FALSE. -NDLEVEL=0 -LOUTVEC=.FALSE. -IFRQ_OUT = 24 !! daily (24h) output -! -LOUTTXT=.FALSE. -CGAUTXT="None" - -!*** 3. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NOUTPUT) - -WRITE(LOGNAM,*) "=== NAMELIST, NOUTPUT ===" -WRITE(LOGNAM,*) "COUTDIR: ", TRIM(COUTDIR) -WRITE(LOGNAM,*) "CVARSOUT: ", TRIM(CVARSOUT) -WRITE(LOGNAM,*) "COUTTAG: ", TRIM(COUTTAG) - -WRITE(LOGNAM,*) "LOUTCDF: ", LOUTCDF -IF( LOUTCDF )THEN - WRITE(LOGNAM,*) "NDLEVEL: ", NDLEVEL -ENDIF -if( LOUTVEC )THEN - WRITE(LOGNAM,*) "LOUTVEC: ", LOUTVEC -ENDIF -WRITE(LOGNAM,*) "IFRQ_OUT ", IFRQ_OUT - -WRITE(LOGNAM,*) "IFRQ_OUT ", LOUTTXT -WRITE(LOGNAM,*) "CGAUTXRT ", CGAUTXT - -CLOSE(NSETFILE) - -WRITE(LOGNAM,*) "CMF::OUTPUT_NMLIST: end" - -END SUBROUTINE CMF_OUTPUT_NMLIST -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_OUTPUT_INIT -! Initialize output module (create/open files) -! -- Called from CMF_DRV_INIT -USE YOS_CMF_INPUT, ONLY: NX,NY -USE YOS_CMF_TIME, ONLY: ISYYYY, ISMM, ISDD, ISHOUR, ISMIN -USE YOS_CMF_MAP, ONLY: NSEQMAX,NPTHOUT,NPTHLEV,REGIONTHIS -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!* Local variables -CHARACTER(LEN=256) :: CTIME, CTMP -INTEGER(KIND=JPIM) :: JF,J,J0 -CHARACTER(LEN=256) :: CVNAMES(NVARS) -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -WRITE(LOGNAM,*) "CMF::OUTPUT_INIT: check output variables" -!! Start by finding out # of output variables -NVARSOUT=0 -J0=1 -DO J=1,LEN(TRIM(CVARSOUT)) - IF( (J>J0) .AND. (CVARSOUT(J:J) .EQ. ',') ) THEN - CTMP=TRIM(ADJUSTL(CVARSOUT(J0:J-1))) - IF (LEN(CTMP) > 0 ) THEN - NVARSOUT=NVARSOUT+1 - CVNAMES(NVARSOUT)=CTMP - ENDIF - J0=J+1 - ENDIF -ENDDO -! Last one -IF ( J0 < LEN(TRIM(CVARSOUT)) ) THEN - J=LEN(TRIM(CVARSOUT)) - CTMP=TRIM(ADJUSTL(CVARSOUT(J0:J))) - IF (LEN(CTMP) > 0 ) THEN - NVARSOUT=NVARSOUT+1 - CVNAMES(NVARSOUT)=CTMP - ENDIF -ENDIF - -IF ( NVARSOUT == 0 ) THEN - WRITE(LOGNAM,*) "CMF::OUTPUT_INIT: No output files will be produced!" - RETURN -ENDIF - -ALLOCATE(VAROUT(NVARSOUT)) -WRITE(CTIME,'(A14,I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2)') 'seconds since ',ISYYYY,'-',ISMM,'-',ISDD,' ',ISHOUR,":",ISMIN - -!* Loop on variables and create files -! add water re-infiltration calculation -! currently was not used in colm-cama coupling model - -DO JF=1,NVARSOUT - WRITE(LOGNAM,*) "Creating output for variable:", TRIM( CVNAMES(JF) ) - SELECT CASE (CVNAMES(JF)) - CASE ('rivout') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='river discharge' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('rivsto') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='river storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('rivdph') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='river depth' - VAROUT(JF)%CVUNITS='m' - CASE ('rivvel') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='river velocity' - VAROUT(JF)%CVUNITS='m/s' - - CASE ('fldout') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='floodplain discharge' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('fldsto') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='floodplain storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('flddph') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='floodplain depth' - VAROUT(JF)%CVUNITS='m' - CASE ('fldfrc') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='flooded fraction' - VAROUT(JF)%CVUNITS='0-1' - CASE ('fldare') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='flooded area' - VAROUT(JF)%CVUNITS='m2' - - CASE ('sfcelv') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='water surface elevation' - VAROUT(JF)%CVUNITS='m' - CASE ('totout') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='discharge (river+floodplain)' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('outflw') !! comparability for previous output name - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='discharge (river+floodplain)' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('totsto') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='total storage (river+floodplain)' - VAROUT(JF)%CVUNITS='m3' - CASE ('storge') !! comparability for previous output name - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='total storage (river+floodplain)' - VAROUT(JF)%CVUNITS='m3' - - CASE ('pthflw') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='bifurcation channel discharge' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('pthout') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='net bifurcation discharge' - VAROUT(JF)%CVUNITS='m3/s' - - CASE ('maxsto') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='daily maximum storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('maxflw') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='daily maximum discharge' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('maxdph') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='daily maximum river depth' - VAROUT(JF)%CVUNITS='m' - - CASE ('runoff') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='Surface runoff' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('runoffsub') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='sub-surface runoff' - VAROUT(JF)%CVUNITS='m3/s' - - CASE ('damsto') !!! added - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='reservoir storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('daminf') !!! added - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='reservoir inflow' - VAROUT(JF)%CVUNITS='m3/s' - - CASE ('levsto') !!! added - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='protected area storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('levdph') !!! added - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='protected area depth' - VAROUT(JF)%CVUNITS='m' - - CASE ('gdwsto') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='ground water storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('gwsto') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='ground water storage' - VAROUT(JF)%CVUNITS='m3' - CASE ('gwout') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='ground water discharge' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('wevap') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='water evaporation' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('winfilt') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='water infiltration' - VAROUT(JF)%CVUNITS='m3/s' - CASE ('outins') - VAROUT(JF)%CVNAME=CVNAMES(JF) - VAROUT(JF)%CVLNAME='instantaneous discharge' - VAROUT(JF)%CVUNITS='m3/s' - - CASE DEFAULT - WRITE(LOGNAM,*) trim(CVNAMES(JF)), ' Not defined in CMF_CREATE_OUTCDF_MOD' - - END SELECT - VAROUT(JF)%BINID=INQUIRE_FID() - -END DO - -IRECOUT=0 ! Initialize Output record to 1 (shared in netcdf & binary) - -CONTAINS -!========================================================== -!+ CREATE_OUTBIN -!+ CREATE_OUTCDF -!========================================================== -SUBROUTINE CREATE_OUTBIN -IMPLICIT NONE -!================================================ -IF( TRIM(VAROUT(JF)%CVNAME)=='pthflw' ) THEN !! bifurcation channel - IF( REGIONTHIS==1 )THEN - VAROUT(JF)%CFILE=TRIM(COUTDIR)//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFPTH) - OPEN(VAROUT(JF)%BINID,FILE=VAROUT(JF)%CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NPTHOUT*NPTHLEV) - WRITE(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID - ENDIF -ELSEIF( LOUTVEC )THEN !! 1D land only output - VAROUT(JF)%CFILE=TRIM(COUTDIR)//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFVEC) - OPEN(VAROUT(JF)%BINID,FILE=VAROUT(JF)%CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NSEQMAX) - WRITE(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID -ELSE !! 2D default map output - IF( REGIONTHIS==1 )THEN - VAROUT(JF)%CFILE=TRIM(COUTDIR)//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFBIN) - WRITE(LOGNAM,*) " -- ", TRIM(VAROUT(JF)%CFILE) - OPEN(VAROUT(JF)%BINID,FILE=VAROUT(JF)%CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) - WRITE(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID - ENDIF -ENDIF - - -END SUBROUTINE CREATE_OUTBIN -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CREATE_OUTCDF + !#################################################################### + ! -- CMF_OUTPUT_NMLIST : Read output file info from namelist + ! -- CMF_OUTPUT_INIT : Create & Open standard output files + ! -- CMF_OUTPUT_WRITE : Write output to files + ! -- CMF_OUTPUT_END : Close standard output files + ! -- + !#################################################################### + SUBROUTINE CMF_OUTPUT_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 1. open namelist + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::OUTPUT_NMLIST: namelist open in unit:", TRIM(CSETFILE), NSETFILE + + !*** 2. default value + COUTDIR="./" + CVARSOUT="outflw,storge,rivdph" + COUTTAG="_cmf" + LOUTCDF=.FALSE. + NDLEVEL=0 + LOUTVEC=.FALSE. + IFRQ_OUT = 24 !! daily (24h) output + ! + LOUTTXT=.FALSE. + CGAUTXT="None" + + !*** 3. read namelist + rewind(NSETFILE) + read(NSETFILE,NML=NOUTPUT) + + write(LOGNAM,*) "=== NAMELIST, NOUTPUT ===" + write(LOGNAM,*) "COUTDIR: ", TRIM(COUTDIR) + write(LOGNAM,*) "CVARSOUT: ", TRIM(CVARSOUT) + write(LOGNAM,*) "COUTTAG: ", TRIM(COUTTAG) + + write(LOGNAM,*) "LOUTCDF: ", LOUTCDF + IF( LOUTCDF )THEN + write(LOGNAM,*) "NDLEVEL: ", NDLEVEL + ENDIF + IF( LOUTVEC )THEN + write(LOGNAM,*) "LOUTVEC: ", LOUTVEC + ENDIF + write(LOGNAM,*) "IFRQ_OUT ", IFRQ_OUT + + write(LOGNAM,*) "IFRQ_OUT ", LOUTTXT + write(LOGNAM,*) "CGAUTXRT ", CGAUTXT + + close(NSETFILE) + + write(LOGNAM,*) "CMF::OUTPUT_NMLIST: end" + + END SUBROUTINE CMF_OUTPUT_NMLIST + !#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_OUTPUT_INIT + ! Initialize output module (create/open files) + ! -- Called from CMF_DRV_INIT + USE YOS_CMF_INPUT, only: NX,NY + USE YOS_CMF_TIME, only: ISYYYY, ISMM, ISDD, ISHOUR, ISMIN + USE YOS_CMF_MAP, only: NSEQMAX,NPTHOUT,NPTHLEV,REGIONTHIS + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !* Local variables + character(LEN=256) :: CTIME, CTMP + integer(KIND=JPIM) :: JF,J,J0 + character(LEN=256) :: CVNAMES(NVARS) + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + write(LOGNAM,*) "CMF::OUTPUT_INIT: check output variables" + !! Start by finding out # of output variables + NVARSOUT=0 + J0=1 + DO J=1,LEN(TRIM(CVARSOUT)) + IF( (J>J0) .and. (CVARSOUT(J:J) .eq. ',') ) THEN + CTMP=TRIM(ADJUSTL(CVARSOUT(J0:J-1))) + IF (LEN(CTMP) > 0 ) THEN + NVARSOUT=NVARSOUT+1 + CVNAMES(NVARSOUT)=CTMP + ENDIF + J0=J+1 + ENDIF + ENDDO + ! Last one + IF ( J0 < LEN(TRIM(CVARSOUT)) ) THEN + J=LEN(TRIM(CVARSOUT)) + CTMP=TRIM(ADJUSTL(CVARSOUT(J0:J))) + IF (LEN(CTMP) > 0 ) THEN + NVARSOUT=NVARSOUT+1 + CVNAMES(NVARSOUT)=CTMP + ENDIF + ENDIF + + IF ( NVARSOUT == 0 ) THEN + write(LOGNAM,*) "CMF::OUTPUT_INIT: No output files will be produced!" + RETURN + ENDIF + + allocate(VAROUT(NVARSOUT)) + write(CTIME,'(A14,I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2)') 'seconds since ',ISYYYY,'-',ISMM,'-',ISDD,' ',ISHOUR,":",ISMIN + + !* Loop on variables and create files + ! add water re-infiltration calculation + ! currently was not used in colm-cama coupling model + + DO JF=1,NVARSOUT + write(LOGNAM,*) "Creating output for variable:", TRIM( CVNAMES(JF) ) + SELECT CASE (CVNAMES(JF)) + CASE ('rivout') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='river discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('rivsto') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='river storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('rivdph') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='river depth' + VAROUT(JF)%CVUNITS='m' + CASE ('rivvel') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='river velocity' + VAROUT(JF)%CVUNITS='m/s' + CASE ('fldout') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='floodplain discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('fldsto') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='floodplain storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('flddph') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='floodplain depth' + VAROUT(JF)%CVUNITS='m' + CASE ('fldfrc') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='flooded fraction' + VAROUT(JF)%CVUNITS='0-1' + CASE ('fldare') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='flooded area' + VAROUT(JF)%CVUNITS='m2' + CASE ('sfcelv') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='water surface elevation' + VAROUT(JF)%CVUNITS='m' + CASE ('totout') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='discharge (river+floodplain)' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('outflw') !! comparability for previous output name + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='discharge (river+floodplain)' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('totsto') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='total storage (river+floodplain)' + VAROUT(JF)%CVUNITS='m3' + CASE ('storge') !! comparability for previous output name + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='total storage (river+floodplain)' + VAROUT(JF)%CVUNITS='m3' + CASE ('pthflw') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='bifurcation channel discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('pthout') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='net bifurcation discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('maxsto') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='daily maximum storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('maxflw') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='daily maximum discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('maxdph') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='daily maximum river depth' + VAROUT(JF)%CVUNITS='m' + CASE ('runoff') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='Surface runoff' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('runoffsub') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='sub-surface runoff' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('damsto') !!! added + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='reservoir storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('daminf') !!! added + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='reservoir inflow' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('levsto') !!! added + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='protected area storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('levdph') !!! added + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='protected area depth' + VAROUT(JF)%CVUNITS='m' + CASE ('gdwsto') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='ground water storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('gwsto') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='ground water storage' + VAROUT(JF)%CVUNITS='m3' + CASE ('gwout') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='ground water discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('wevap') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='water evaporation' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('winfilt') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='water infiltration' + VAROUT(JF)%CVUNITS='m3/s' + CASE ('outins') + VAROUT(JF)%CVNAME=CVNAMES(JF) + VAROUT(JF)%CVLNAME='instantaneous discharge' + VAROUT(JF)%CVUNITS='m3/s' + CASE DEFAULT + write(LOGNAM,*) trim(CVNAMES(JF)), ' Not defined in CMF_CREATE_OUTCDF_MOD' + + END SELECT + VAROUT(JF)%BINID=INQUIRE_FID() + ENDDO + + IRECOUT=0 ! Initialize Output record to 1 (shared in netcdf & binary) + + CONTAINS + !========================================================== + !+ CREATE_OUTBIN + !+ CREATE_OUTCDF + !========================================================== + SUBROUTINE CREATE_OUTBIN + IMPLICIT NONE + !================================================ + IF( TRIM(VAROUT(JF)%CVNAME)=='pthflw' ) THEN !! bifurcation channel + IF( REGIONTHIS==1 )THEN + VAROUT(JF)%CFILE=TRIM(COUTDIR)//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFPTH) + open(VAROUT(JF)%BINID,FILE=VAROUT(JF)%CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NPTHOUT*NPTHLEV) + write(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID + ENDIF + ELSEIF( LOUTVEC )THEN !! 1D land only output + VAROUT(JF)%CFILE=TRIM(COUTDIR)//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFVEC) + open(VAROUT(JF)%BINID,FILE=VAROUT(JF)%CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NSEQMAX) + write(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID + ELSE !! 2D default map output + IF( REGIONTHIS==1 )THEN + VAROUT(JF)%CFILE=TRIM(COUTDIR)//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFBIN) + write(LOGNAM,*) " -- ", TRIM(VAROUT(JF)%CFILE) + open(VAROUT(JF)%BINID,FILE=VAROUT(JF)%CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + write(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID + ENDIF + ENDIF + END SUBROUTINE CREATE_OUTBIN + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CREATE_OUTCDF #ifdef UseCDF_CMF -USE YOS_CMF_INPUT, ONLY: RMIS -USE YOS_CMF_MAP, ONLY: D1LON, D1LAT -USE CMF_UTILS_MOD, ONLY: NCERROR -USE NETCDF -IMPLICIT NONE -INTEGER(KIND=JPIM) :: TIMEID,VARID,LATID,LONID -!============ -VAROUT(JF)%IRECNC=1 ! initialize record current writting record to 1 - -!============ -VAROUT(JF)%CFILE=TRIM(COUTDIR)//'o_'//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFCDF) -! Create file -CALL NCERROR( NF90_CREATE(VAROUT(JF)%CFILE,NF90_NETCDF4,VAROUT(JF)%NCID),& - 'CREATING FILE:'//TRIM(VAROUT(JF)%CFILE) ) -!=== set dimension === -CALL NCERROR( NF90_DEF_DIM(VAROUT(JF)%NCID, 'time', NF90_UNLIMITED, TIMEID) ) -CALL NCERROR( NF90_DEF_DIM(VAROUT(JF)%NCID, 'lat', NY, LATID) ) -CALL NCERROR( NF90_DEF_DIM(VAROUT(JF)%NCID, 'lon', NX, LONID) ) - -!=== define variables === -CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, 'lat', NF90_FLOAT, (/LATID/), VARID) ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'long_name','latitude') ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'units','degrees_north') ) - -CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, 'lon', NF90_FLOAT, (/LONID/), VARID) ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'long_name','longitude') ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'units','degrees_east') ) - -CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, 'time', NF90_DOUBLE, (/TIMEID/), VAROUT(JF)%TIMID) ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%TIMID, 'long_name','time') ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%TIMID, 'units',CTIME) ) - -!=== -CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, VAROUT(JF)%CVNAME, NF90_FLOAT, & - (/LONID,LATID,TIMEID/), VAROUT(JF)%VARID,DEFLATE_LEVEL=NDLEVEL), & - 'Creating Variable') - -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%VARID, 'long_name', TRIM(VAROUT(JF)%CVLNAME)) ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%VARID, 'units', TRIM(VAROUT(JF)%CVUNITS)) ) -CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%VARID, '_FillValue',RMIS) ) - -CALL NCERROR( NF90_ENDDEF(VAROUT(JF)%NCID) ) - -!=== put lon lat info === -CALL NCERROR ( NF90_INQ_VARID(VAROUT(JF)%NCID,'lon',VARID),'getting id' ) -CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VARID,D1LON)) - -CALL NCERROR ( NF90_INQ_VARID(VAROUT(JF)%NCID,'lat',VARID),'getting id' ) -CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VARID,D1LAT)) - -WRITE(LOGNAM,*) 'CFILE: ',TRIM(VAROUT(JF)%CFILE),' CVAR:',TRIM(VAROUT(JF)%CVNAME),& - ' CLNAME: ',TRIM(VAROUT(JF)%CVLNAME),' CUNITS: ',TRIM(VAROUT(JF)%CVUNITS) -WRITE(LOGNAM,*) 'OPEN IN UNIT: ',VAROUT(JF)%NCID + USE YOS_CMF_INPUT, only: RMIS + USE YOS_CMF_MAP, only: D1LON, D1LAT + USE CMF_UTILS_MOD, only: NCERROR + USE NETCDF + IMPLICIT NONE + integer(KIND=JPIM) :: TIMEID,VARID,LATID,LONID + !============ + VAROUT(JF)%IRECNC=1 ! initialize record current writting record to 1 + + !============ + VAROUT(JF)%CFILE=TRIM(COUTDIR)//'o_'//TRIM(VAROUT(JF)%CVNAME)//TRIM(COUTTAG)//TRIM(CSUFCDF) + ! Create file + CALL NCERROR( NF90_CREATE(VAROUT(JF)%CFILE,NF90_NETCDF4,VAROUT(JF)%NCID),& + 'CREATING FILE:'//TRIM(VAROUT(JF)%CFILE) ) + !=== set dimension === + CALL NCERROR( NF90_DEF_DIM(VAROUT(JF)%NCID, 'time', NF90_UNLIMITED, TIMEID) ) + CALL NCERROR( NF90_DEF_DIM(VAROUT(JF)%NCID, 'lat', NY, LATID) ) + CALL NCERROR( NF90_DEF_DIM(VAROUT(JF)%NCID, 'lon', NX, LONID) ) + + !=== define variables === + CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, 'lat', NF90_FLOAT, (/LATID/), VARID) ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'long_name','latitude') ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'units','degrees_north') ) + + CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, 'lon', NF90_FLOAT, (/LONID/), VARID) ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'long_name','longitude') ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VARID, 'units','degrees_east') ) + + CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, 'time', NF90_DOUBLE, (/TIMEID/), VAROUT(JF)%TIMID) ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%TIMID, 'long_name','time') ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%TIMID, 'units',CTIME) ) + + !=== + CALL NCERROR( NF90_DEF_VAR(VAROUT(JF)%NCID, VAROUT(JF)%CVNAME, NF90_FLOAT, & + (/LONID,LATID,TIMEID/), VAROUT(JF)%VARID,DEFLATE_LEVEL=NDLEVEL), & + 'Creating Variable') + + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%VARID, 'long_name', TRIM(VAROUT(JF)%CVLNAME)) ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%VARID, 'units', TRIM(VAROUT(JF)%CVUNITS)) ) + CALL NCERROR( NF90_PUT_ATT(VAROUT(JF)%NCID, VAROUT(JF)%VARID, '_FillValue',RMIS) ) + + CALL NCERROR( NF90_ENDDEF(VAROUT(JF)%NCID) ) + + !=== put lon lat info === + CALL NCERROR ( NF90_INQ_VARID(VAROUT(JF)%NCID,'lon',VARID),'getting id' ) + CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VARID,D1LON)) + + CALL NCERROR ( NF90_INQ_VARID(VAROUT(JF)%NCID,'lat',VARID),'getting id' ) + CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VARID,D1LAT)) + + write(LOGNAM,*) 'CFILE: ',TRIM(VAROUT(JF)%CFILE),' CVAR:',TRIM(VAROUT(JF)%CVNAME),& + ' CLNAME: ',TRIM(VAROUT(JF)%CVLNAME),' CUNITS: ',TRIM(VAROUT(JF)%CVUNITS) + write(LOGNAM,*) 'open in UNIT: ',VAROUT(JF)%NCID #endif -END SUBROUTINE CREATE_OUTCDF -!========================================================== - -END SUBROUTINE CMF_OUTPUT_INIT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_OUTPUT_WRITE -!====== -USE CMF_UTILS_MOD, ONLY: vecD2mapR -! save results to output files -! -- Called either from "MAIN/Coupler" or CMF_DRV_ADVANCE -USE YOS_CMF_INPUT, ONLY: NX, NY, LOUTINI -USE YOS_CMF_MAP, ONLY: NSEQMAX, NPTHOUT, NPTHLEV, REGIONTHIS -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JHHMM, JHOUR, JMIN, KSTEP -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, P2GDWSTO, & - & P2DAMSTO, P2LEVSTO, D2COPY !!! added -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV, D2STORGE, & - & D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & - & D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, D2WEVAPEX_AVG,D2WINFILTEX_AVG, & - & D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX, & - & D2DAMINF_AVG, D2OUTINS, D2LEVDPH !!! added + END SUBROUTINE CREATE_OUTCDF + !========================================================== + + END SUBROUTINE CMF_OUTPUT_INIT + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_OUTPUT_WRITE + !====== + USE CMF_UTILS_MOD, only: vecD2mapR + ! save results to output files + ! -- Called either from "MAIN/Coupler" or CMF_DRV_ADVANCE + USE YOS_CMF_INPUT, only: NX, NY, LOUTINI + USE YOS_CMF_MAP, only: NSEQMAX, NPTHOUT, NPTHLEV, REGIONTHIS + USE YOS_CMF_TIME, only: JYYYYMMDD, JHHMM, JHOUR, JMIN, KSTEP + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, P2GDWSTO, & + & P2DAMSTO, P2LEVSTO, D2COPY !!! added + USE YOS_CMF_DIAG, only: D2RIVDPH, D2FLDDPH, D2FLDFRC, D2FLDARE, D2SFCELV, D2STORGE, & + & D2OUTFLW_AVG, D2RIVOUT_AVG, D2FLDOUT_AVG, D2PTHOUT_AVG, D1PTHFLW_AVG, & + & D2RIVVEL_AVG, D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, D2WEVAPEX_AVG,D2WINFILTEX_AVG, & + & D2OUTFLW_MAX, D2STORGE_MAX, D2RIVDPH_MAX, & + & D2DAMINF_AVG, D2OUTINS, D2LEVDPH !!! added #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_AllReduce_R2MAP, CMF_MPI_AllReduce_R1PTH + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R2MAP, CMF_MPI_AllReduce_R1PTH #endif -IMPLICIT NONE -INTEGER(KIND=JPIM) :: JF -REAL(KIND=JPRB),POINTER :: D2VEC(:,:) ! point data location to output -!*** LOCAL -REAL(KIND=JPRM) :: R2OUT(NX,NY) -REAL(KIND=JPRM) :: R1POUT(NPTHOUT,NPTHLEV) -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 0. check date:hour with output frequency -IF ( MOD(JHOUR,IFRQ_OUT)==0 .and. JMIN==0 ) THEN ! JHOUR: end of time step , NFPPH: output frequency (hour) - - !*** 1. update IREC & calc average variable - IRECOUT=IRECOUT+1 - WRITE(LOGNAM,*) 'CMF::OUTPUT_WRITE: write at time: ', JYYYYMMDD, JHHMM, IRECOUT - - !*** 2. check variable name & allocate data to pointer DVEC - DO JF=1,NVARSOUT - SELECT CASE (VAROUT(JF)%CVNAME) - CASE ('rivsto') - D2COPY=P2RIVSTO !! convert Double to Single precision when using SinglePrecisionMode - D2VEC => D2COPY !! (Storage variables are kept as Float64 in SinglePrecisionMode) - CASE ('fldsto') - D2COPY=P2FLDSTO - D2VEC => D2COPY - - CASE ('rivout') - D2VEC => D2RIVOUT_AVG - CASE ('rivdph') - D2VEC => D2RIVDPH - CASE ('rivvel') - D2VEC => D2RIVVEL_AVG - CASE ('fldout') - D2VEC => D2FLDOUT_AVG - - CASE ('flddph') - D2VEC => D2FLDDPH - CASE ('fldfrc') - D2VEC => D2FLDFRC - CASE ('fldare') - D2VEC => D2FLDARE - CASE ('sfcelv') - D2VEC => D2SFCELV - - CASE ('totout') - D2VEC => D2OUTFLW_AVG - CASE ('outflw') !! compatibility for previous file name - D2VEC => D2OUTFLW_AVG - CASE ('totsto') - D2VEC => D2STORGE - CASE ('storge') !! compatibility for previous file name - D2VEC => D2STORGE - - CASE ('pthout') - IF( .not. LPTHOUT ) CYCLE - D2VEC => D2PTHOUT_AVG - CASE ('pthflw') - IF( .not. LPTHOUT ) CYCLE - CASE ('maxflw') - D2VEC => D2OUTFLW_MAX - CASE ('maxdph') - D2VEC => D2RIVDPH_MAX - CASE ('maxsto') - D2VEC => D2STORGE_MAX - - CASE ('outins') - IF( .not. LOUTINS ) CYCLE - D2VEC => D2OUTINS - - CASE ('gwsto') - IF( .not. LGDWDLY ) CYCLE - D2COPY=P2GDWSTO - D2VEC => D2COPY - CASE ('gdwsto') - IF( .not. LGDWDLY ) CYCLE - D2COPY=P2GDWSTO - D2VEC => D2COPY - CASE ('gwout') - IF( .not. LGDWDLY ) CYCLE - D2VEC => D2GDWRTN_AVG - CASE ('gdwrtn') - IF( .not. LGDWDLY ) CYCLE - D2VEC => D2GDWRTN_AVG - - CASE ('runoff') !! compatibility for previous file name - D2VEC => D2RUNOFF_AVG - CASE ('runoffsub') !! compatibility for previous file name - IF( .not. LROSPLIT ) CYCLE - D2VEC => D2ROFSUB_AVG - CASE ('rofsfc') - D2VEC => D2RUNOFF_AVG - CASE ('rofsub') - D2VEC => D2ROFSUB_AVG - CASE ('wevap') - IF( .not. LWEVAP ) CYCLE - D2VEC => D2WEVAPEX_AVG - CASE ('winfilt') - IF( .not. LWINFILT ) CYCLE - D2VEC => D2WINFILTEX_AVG - CASE ('damsto') !!! added - IF( .not. LDAMOUT ) CYCLE - D2COPY=P2DAMSTO - D2VEC => D2COPY - CASE ('daminf') !!! added - IF( .not. LDAMOUT ) CYCLE - D2VEC => d2daminf_avg - - CASE ('levsto') !!! added - IF( .not. LLEVEE ) CYCLE - D2COPY=P2LEVSTO - D2VEC => D2COPY - CASE ('levdph') !!! added - IF( .not. LLEVEE ) CYCLE - D2VEC => D2LEVDPH - - CASE DEFAULT - - END SELECT !! variable name select - - IF( KSTEP==0 .and. LOUTINI )THEN !! write storage only when LOUTINI specified - IF ( .not. LOUTCDF ) CYCLE - IF ( VAROUT(JF)%CVNAME/='rivsto' .and. VAROUT(JF)%CVNAME/='fldsto' .and. VAROUT(JF)%CVNAME/='gwsto' ) CYCLE - ENDIF - -!! convert 1Dvector to 2Dmap - IF( VAROUT(JF)%CVNAME/='pthflw' ) THEN !! usual 2D map variable - CALL vecD2mapR(D2VEC,R2OUT) !! MPI node data is gathered by vecP2mapR + IMPLICIT NONE + integer(KIND=JPIM) :: JF + real(KIND=JPRB),POINTER :: D2VEC(:,:) ! point data location to output + !*** LOCAL + real(KIND=JPRM) :: R2OUT(NX,NY) + real(KIND=JPRM) :: R1POUT(NPTHOUT,NPTHLEV) + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 0. check date:hour with output frequency + IF ( MOD(JHOUR,IFRQ_OUT)==0 .and. JMIN==0 ) THEN ! JHOUR: end of time step , NFPPH: output frequency (hour) + + !*** 1. update IREC & calc average variable + IRECOUT=IRECOUT+1 + write(LOGNAM,*) 'CMF::OUTPUT_WRITE: write at time: ', JYYYYMMDD, JHHMM, IRECOUT + + !*** 2. check variable name & allocate data to pointer DVEC + DO JF=1,NVARSOUT + SELECT CASE (VAROUT(JF)%CVNAME) + CASE ('rivsto') + D2COPY=P2RIVSTO !! convert Double to Single precision when using SinglePrecisionMode + D2VEC => D2COPY !! (Storage variables are kept as Float64 in SinglePrecisionMode) + CASE ('fldsto') + D2COPY=P2FLDSTO + D2VEC => D2COPY + CASE ('rivout') + D2VEC => D2RIVOUT_AVG + CASE ('rivdph') + D2VEC => D2RIVDPH + CASE ('rivvel') + D2VEC => D2RIVVEL_AVG + CASE ('fldout') + D2VEC => D2FLDOUT_AVG + CASE ('flddph') + D2VEC => D2FLDDPH + CASE ('fldfrc') + D2VEC => D2FLDFRC + CASE ('fldare') + D2VEC => D2FLDARE + CASE ('sfcelv') + D2VEC => D2SFCELV + CASE ('totout') + D2VEC => D2OUTFLW_AVG + CASE ('outflw') !! compatibility for previous file name + D2VEC => D2OUTFLW_AVG + CASE ('totsto') + D2VEC => D2STORGE + CASE ('storge') !! compatibility for previous file name + D2VEC => D2STORGE + CASE ('pthout') + IF( .not. LPTHOUT ) CYCLE + D2VEC => D2PTHOUT_AVG + CASE ('pthflw') + IF( .not. LPTHOUT ) CYCLE + CASE ('maxflw') + D2VEC => D2OUTFLW_MAX + CASE ('maxdph') + D2VEC => D2RIVDPH_MAX + CASE ('maxsto') + D2VEC => D2STORGE_MAX + CASE ('outins') + IF( .not. LOUTINS ) CYCLE + D2VEC => D2OUTINS + CASE ('gwsto') + IF( .not. LGDWDLY ) CYCLE + D2COPY=P2GDWSTO + D2VEC => D2COPY + CASE ('gdwsto') + IF( .not. LGDWDLY ) CYCLE + D2COPY=P2GDWSTO + D2VEC => D2COPY + CASE ('gwout') + IF( .not. LGDWDLY ) CYCLE + D2VEC => D2GDWRTN_AVG + CASE ('gdwrtn') + IF( .not. LGDWDLY ) CYCLE + D2VEC => D2GDWRTN_AVG + CASE ('runoff') !! compatibility for previous file name + D2VEC => D2RUNOFF_AVG + CASE ('runoffsub') !! compatibility for previous file name + IF( .not. LROSPLIT ) CYCLE + D2VEC => D2ROFSUB_AVG + CASE ('rofsfc') + D2VEC => D2RUNOFF_AVG + CASE ('rofsub') + D2VEC => D2ROFSUB_AVG + CASE ('wevap') + IF( .not. LWEVAP ) CYCLE + D2VEC => D2WEVAPEX_AVG + CASE ('winfilt') + IF( .not. LWINFILT ) CYCLE + D2VEC => D2WINFILTEX_AVG + CASE ('damsto') !!! added + IF( .not. LDAMOUT ) CYCLE + D2COPY=P2DAMSTO + D2VEC => D2COPY + CASE ('daminf') !!! added + IF( .not. LDAMOUT ) CYCLE + D2VEC => d2daminf_avg + CASE ('levsto') !!! added + IF( .not. LLEVEE ) CYCLE + D2COPY=P2LEVSTO + D2VEC => D2COPY + CASE ('levdph') !!! added + IF( .not. LLEVEE ) CYCLE + D2VEC => D2LEVDPH + CASE DEFAULT + END SELECT !! variable name select + + IF( KSTEP==0 .and. LOUTINI )THEN !! write storage only when LOUTINI specified + IF ( .not. LOUTCDF ) CYCLE + IF ( VAROUT(JF)%CVNAME/='rivsto' .and. VAROUT(JF)%CVNAME/='fldsto' .and. VAROUT(JF)%CVNAME/='gwsto' ) CYCLE + ENDIF + + !! convert 1Dvector to 2Dmap + IF( VAROUT(JF)%CVNAME/='pthflw' ) THEN !! usual 2D map variable + CALL vecD2mapR(D2VEC,R2OUT) !! MPI node data is gathered by vecP2mapR #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_R2MAP(R2OUT) + CALL CMF_MPI_AllReduce_R2MAP(R2OUT) #endif - ELSE - IF( .not. LPTHOUT ) CYCLE - R1POUT(:,:)=REAL(D1PTHFLW_AVG(:,:)) + ELSE + IF( .not. LPTHOUT ) CYCLE + R1POUT(:,:)=real(D1PTHFLW_AVG(:,:)) #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_R1PTH(R1POUT) + CALL CMF_MPI_AllReduce_R1PTH(R1POUT) #endif - ENDIF - - !*** 3. write D2VEC to output file - IF ( LOUTCDF ) THEN - IF ( REGIONTHIS==1 ) CALL WRTE_OUTCDF !! netCDFG - ELSE - IF( VAROUT(JF)%CVNAME=='pthflw' ) THEN - IF ( REGIONTHIS==1 ) CALL WRTE_OUTPTH(VAROUT(JF)%BINID,IRECOUT,R1POUT) !! 1D bifu channel - ELSE - IF( LOUTVEC )THEN - CALL WRTE_OUTVEC(VAROUT(JF)%BINID,IRECOUT,D2VEC) !! 1D vector (optional) - ELSE - IF ( REGIONTHIS==1 ) CALL WRTE_OUTBIN(VAROUT(JF)%BINID,IRECOUT,R2OUT) !! 2D map - ENDIF - ENDIF - ENDIF - END DO - - WRITE(LOGNAM,*) 'CMF::OUTPUT_WRITE: end' + ENDIF + + !*** 3. write D2VEC to output file + IF ( LOUTCDF ) THEN + IF ( REGIONTHIS==1 ) CALL WRTE_OUTCDF !! netCDFG + ELSE + IF( VAROUT(JF)%CVNAME=='pthflw' ) THEN + IF ( REGIONTHIS==1 ) CALL WRTE_OUTPTH(VAROUT(JF)%BINID,IRECOUT,R1POUT) !! 1D bifu channel + ELSE + IF( LOUTVEC )THEN + CALL WRTE_OUTVEC(VAROUT(JF)%BINID,IRECOUT,D2VEC) !! 1D vector (optional) + ELSE + IF ( REGIONTHIS==1 ) CALL WRTE_OUTBIN(VAROUT(JF)%BINID,IRECOUT,R2OUT) !! 2D map + ENDIF + ENDIF + ENDIF + ENDDO + + write(LOGNAM,*) 'CMF::OUTPUT_WRITE: end' -ENDIF + ENDIF -!========================================================== -CONTAINS -!+ WRTE_OUTBIN -!+ WRTE_OUTPTH -!+ WRTE_OUTVEC -!+ WRTE_OUTCDF -!========================================================== -SUBROUTINE WRTE_OUTBIN(IFN,IREC,R2OUTDAT) -IMPLICIT NONE -!*** INPUT -INTEGER(KIND=JPIM),INTENT(IN) :: IFN !! FILE NUMBER -INTEGER(KIND=JPIM),INTENT(IN) :: IREC !! RECORD -REAL(KIND=JPRM) :: R2OUTDAT(NX,NY) -!================================================ -WRITE(IFN,REC=IREC) R2OUTDAT - -END SUBROUTINE WRTE_OUTBIN -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE WRTE_OUTPTH(IFN,IREC,R2OUTDAT) -IMPLICIT NONE -!*** INPUT -INTEGER(KIND=JPIM),INTENT(IN) :: IFN !! FILE NUMBER -INTEGER(KIND=JPIM),INTENT(IN) :: IREC !! RECORD -REAL(KIND=JPRM) :: R2OUTDAT(NPTHOUT,NPTHLEV) -!================================================ -WRITE(IFN,REC=IREC) R2OUTDAT - -END SUBROUTINE WRTE_OUTPTH -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE WRTE_OUTVEC(IFN,IREC,D2OUTDAT) -IMPLICIT NONE -!*** INPUT -INTEGER(KIND=JPIM),INTENT(IN) :: IFN !! FILE NUMBER -INTEGER(KIND=JPIM),INTENT(IN) :: IREC !! RECORD -REAL(KIND=JPRB),INTENT(IN) :: D2OUTDAT(NSEQMAX,1) !! OUTPUT DATA -!*** LOCAL -REAL(KIND=JPRM) :: R2OUTDAT(NSEQMAX,1) -!================================================ -R2OUTDAT(:,:)=REAL(D2OUTDAT(:,:)) -WRITE(IFN,REC=IREC) R2OUTDAT - -END SUBROUTINE WRTE_OUTVEC -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE WRTE_OUTCDF + !========================================================== + CONTAINS + !+ WRTE_OUTBIN + !+ WRTE_OUTPTH + !+ WRTE_OUTVEC + !+ WRTE_OUTCDF + !========================================================== + SUBROUTINE WRTE_OUTBIN(IFN,IREC,R2OUTDAT) + IMPLICIT NONE + !*** INPUT + integer(KIND=JPIM),intent(in) :: IFN !! FILE NUMBER + integer(KIND=JPIM),intent(in) :: IREC !! RECORD + real(KIND=JPRM) :: R2OUTDAT(NX,NY) + !================================================ + write(IFN,REC=IREC) R2OUTDAT + + END SUBROUTINE WRTE_OUTBIN + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE WRTE_OUTPTH(IFN,IREC,R2OUTDAT) + IMPLICIT NONE + !*** INPUT + integer(KIND=JPIM),intent(in) :: IFN !! FILE NUMBER + integer(KIND=JPIM),intent(in) :: IREC !! RECORD + real(KIND=JPRM) :: R2OUTDAT(NPTHOUT,NPTHLEV) + !================================================ + write(IFN,REC=IREC) R2OUTDAT + + END SUBROUTINE WRTE_OUTPTH + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE WRTE_OUTVEC(IFN,IREC,D2OUTDAT) + IMPLICIT NONE + !*** INPUT + integer(KIND=JPIM),intent(in) :: IFN !! FILE NUMBER + integer(KIND=JPIM),intent(in) :: IREC !! RECORD + real(KIND=JPRB),intent(in) :: D2OUTDAT(NSEQMAX,1) !! OUTPUT DATA + !*** LOCAL + real(KIND=JPRM) :: R2OUTDAT(NSEQMAX,1) + !================================================ + R2OUTDAT(:,:)=real(D2OUTDAT(:,:)) + write(IFN,REC=IREC) R2OUTDAT + + END SUBROUTINE WRTE_OUTVEC + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE WRTE_OUTCDF #ifdef UseCDF_CMF -USE NETCDF -USE YOS_CMF_TIME, ONLY: KMINSTART,KMINNEXT -USE CMF_UTILS_MOD, ONLY: NCERROR -IMPLICIT NONE -REAL(KIND=JPRB) :: XTIME ! seconds since start of the run ! + USE NETCDF + USE YOS_CMF_TIME, only: KMINSTART,KMINNEXT + USE CMF_UTILS_MOD, only: NCERROR + IMPLICIT NONE + real(KIND=JPRB) :: XTIME ! seconds since start of the run ! -!================================================ -XTIME=REAL( (KMINNEXT-KMINSTART),JPRB) *60._JPRB !! for netCDF -CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VAROUT(JF)%TIMID,XTIME,(/VAROUT(JF)%IRECNC/)) ) + !================================================ + XTIME=real( (KMINNEXT-KMINSTART),JPRB) *60._JPRB !! for netCDF + CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VAROUT(JF)%TIMID,XTIME,(/VAROUT(JF)%IRECNC/)) ) -CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VAROUT(JF)%VARID,R2OUT(1:NX,1:NY),(/1,1,VAROUT(JF)%IRECNC/),(/NX,NY,1/)) ) + CALL NCERROR( NF90_PUT_VAR(VAROUT(JF)%NCID,VAROUT(JF)%VARID,R2OUT(1:NX,1:NY),(/1,1,VAROUT(JF)%IRECNC/),(/NX,NY,1/)) ) -! update IREC -VAROUT(JF)%IRECNC=VAROUT(JF)%IRECNC+1 + ! update IREC + VAROUT(JF)%IRECNC=VAROUT(JF)%IRECNC+1 -! Comment out this as it slows down significantly the writting in the cray -!CALL NCERROR( NF90_SYNC(VAROUT(JF)%NCID) ) + ! Comment out this as it slows down significantly the writting in the cray + !CALL NCERROR( NF90_SYNC(VAROUT(JF)%NCID) ) #endif -END SUBROUTINE WRTE_OUTCDF -!========================================================== + END SUBROUTINE WRTE_OUTCDF + !========================================================== -END SUBROUTINE CMF_OUTPUT_WRITE -!#################################################################### + END SUBROUTINE CMF_OUTPUT_WRITE + !#################################################################### -!#################################################################### -SUBROUTINE CMF_OUTPUT_END -! Finalize output module (close files) -! -- Called from CMF_DRV_END + !#################################################################### + SUBROUTINE CMF_OUTPUT_END + ! Finalize output module (close files) + ! -- Called from CMF_DRV_END #ifdef UseCDF_CMF -USE NETCDF -USE CMF_UTILS_MOD, ONLY: NCERROR + USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR #endif -USE YOS_CMF_MAP, ONLY: REGIONTHIS -IMPLICIT NONE -! Local variables -INTEGER(KIND=JPIM) :: JF -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) "CMF::OUTPUT_END: finalize output module" - -IF( REGIONTHIS==1 )THEN - IF (LOUTCDF) THEN + USE YOS_CMF_MAP, only: REGIONTHIS + IMPLICIT NONE + ! Local variables + integer(KIND=JPIM) :: JF + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) "CMF::OUTPUT_END: finalize output module" + + IF( REGIONTHIS==1 )THEN + IF (LOUTCDF) THEN #ifdef UseCDF_CMF - DO JF=1,NVARSOUT - CALL NCERROR( NF90_CLOSE(VAROUT(JF)%NCID)) - WRITE(LOGNAM,*) "Output netcdf output unit closed:",VAROUT(JF)%NCID - ENDDO + DO JF=1,NVARSOUT + CALL NCERROR( NF90_CLOSE(VAROUT(JF)%NCID)) + write(LOGNAM,*) "Output netcdf output unit closed:",VAROUT(JF)%NCID + ENDDO #endif - ELSE !! binary output - DO JF=1,NVARSOUT - CLOSE(VAROUT(JF)%BINID) - WRITE(LOGNAM,*) "Output binary output unit closed:",VAROUT(JF)%BINID - ENDDO - IF( LOUTVEC )THEN - CALL WRTE_mapR2vecD !! write map-vector conversion file - ENDIF - ENDIF -ENDIF - -WRITE(LOGNAM,*) "CMF::OUTPUT_END: end" - - -CONTAINS -!========================================================== -!+ WRTE_mapR2vecD -!+ -!+ -!========================================================== -SUBROUTINE WRTE_mapR2vecD !! 1D sequence vector informtion required to convert MPI distributed vector output to 2D map -USE YOS_CMF_INPUT, ONLY: TMPNAM -USE YOS_CMF_MAP, ONLY: I1SEQX, I1SEQY, NSEQMAX -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!* local variable -CHARACTER(LEN=256) :: CFILE1 -!================================================ -IF( LOUTVEC )THEN - CFILE1='./ind_xy'//TRIM(CSUFVEC) - - WRITE(LOGNAM,*) "LOUTVEC: write mapR2vecD conversion table", TRIM(CFILE1) - - TMPNAM=INQUIRE_FID() - OPEN(TMPNAM,FILE=CFILE1,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NSEQMAX) - WRITE(TMPNAM,REC=1) I1SEQX - WRITE(TMPNAM,REC=2) I1SEQY - CLOSE(TMPNAM) -ENDIF - -END SUBROUTINE WRTE_mapR2vecD -!================================================ - - -END SUBROUTINE CMF_OUTPUT_END -!#################################################################### - - - -!#################################################################### -SUBROUTINE CMF_OUTTXT_WRTE -USE YOS_CMF_DIAG, ONLY: D2OUTFLW -USE YOS_CMF_TIME, ONLY: IYYYYMMDD,ISYYYY -USE YOS_CMF_MAP, ONLY: I2VECTOR -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID - -! local -INTEGER(KIND=JPIM) :: GID, GIX, GIY, GISEQ -CHARACTER(len=256),SAVE :: GNAME - -INTEGER(KIND=JPIM),SAVE :: IGAUGE, NGAUGE, NGAUGEX -INTEGER(KIND=JPIM),ALLOCATABLE,SAVE :: WriteID(:), WriteISEQ(:) -CHARACTER(len=9),ALLOCATABLE,SAVE :: WriteName(:) -REAL(KIND=JPRB),ALLOCATABLE,SAVE :: WriteOut(:) - -! File IO -INTEGER(KIND=JPIM),SAVE :: LOGOUTTXT -CHARACTER(len=4),SAVE :: cYYYY -CHARACTER(len=256),SAVE :: CLEN, CFMT -CHARACTER(len=256),SAVE :: COUTTXT -LOGICAL,SAVE :: IsOpen -DATA IsOpen /.FALSE./ - -! ====== - -IF( LOUTTXT )THEN - - IF( .not. IsOpen)THEN - IsOpen=.TRUE. - - NGAUGEX=0 - LOGOUTTXT=INQUIRE_FID() - OPEN(LOGOUTTXT,FILE=CGAUTXT,FORM='formatted',STATUS='old') - READ(LOGOUTTXT,*) NGAUGE - DO IGAUGE=1, NGAUGE - READ(LOGOUTTXT,*) GID, GNAME, GIX, GIY - IF( I2VECTOR(GIX,GIY)>0 )THEN - NGAUGEX=NGAUGEX+1 - ENDIF - END DO - CLOSE(LOGOUTTXT) - - ALLOCATE( WriteID(NGAUGEX),WriteISEQ(NGAUGEX),WriteOut(NGAUGEX),WriteName(NGAUGEX)) - - NGAUGEX=0 - OPEN(LOGOUTTXT,FILE=CGAUTXT,FORM='formatted',STATUS='old') - READ(LOGOUTTXT,*) NGAUGE - DO IGAUGE=1, NGAUGE - READ(LOGOUTTXT,*) GID, GNAME, GIX, GIY - IF( I2VECTOR(GIX,GIY)>0 )THEN - NGAUGEX=NGAUGEX+1 - WriteID(NGAUGEX) =GID - WriteName(NGAUGEX)=TRIM(GNAME) - WriteISEQ(NGAUGEX)=I2VECTOR(GIX,GIY) + ELSE !! binary output + DO JF=1,NVARSOUT + close(VAROUT(JF)%BINID) + write(LOGNAM,*) "Output binary output unit closed:",VAROUT(JF)%BINID + ENDDO + IF( LOUTVEC )THEN + CALL WRTE_mapR2vecD !! write map-vector conversion file + ENDIF + ENDIF ENDIF - END DO - CLOSE(LOGOUTTXT) - - ! ============ - WRITE(CYYYY,'(i4.4)') ISYYYY - COUTTXT='./outtxt-'//TRIM(cYYYY)//'.txt' - LOGOUTTXT=INQUIRE_FID() - OPEN(LOGOUTTXT,FILE=COUTTXT,FORM='formatted') + write(LOGNAM,*) "CMF::OUTPUT_END: end" + + + CONTAINS + !========================================================== + !+ WRTE_mapR2vecD + !+ + !+ + !========================================================== + SUBROUTINE WRTE_mapR2vecD !! 1D sequence vector informtion required to convert MPI distributed vector output to 2D map + USE YOS_CMF_INPUT, only: TMPNAM + USE YOS_CMF_MAP, only: I1SEQX, I1SEQY, NSEQMAX + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !* local variable + character(LEN=256) :: CFILE1 + !================================================ + IF( LOUTVEC )THEN + CFILE1='./ind_xy'//TRIM(CSUFVEC) + + write(LOGNAM,*) "LOUTVEC: write mapR2vecD conversion table", TRIM(CFILE1) + + TMPNAM=INQUIRE_FID() + open(TMPNAM,FILE=CFILE1,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NSEQMAX) + write(TMPNAM,REC=1) I1SEQX + write(TMPNAM,REC=2) I1SEQY + close(TMPNAM) + ENDIF + + END SUBROUTINE WRTE_mapR2vecD + !================================================ + + + END SUBROUTINE CMF_OUTPUT_END + !#################################################################### + + + + !#################################################################### + SUBROUTINE CMF_OUTTXT_WRTE + USE YOS_CMF_DIAG, only: D2OUTFLW + USE YOS_CMF_TIME, only: IYYYYMMDD,ISYYYY + USE YOS_CMF_MAP, only: I2VECTOR + USE CMF_UTILS_MOD, only: INQUIRE_FID + + ! local + integer(KIND=JPIM) :: GID, GIX, GIY, GISEQ + character(len=256),SAVE :: GNAME + + integer(KIND=JPIM),SAVE :: IGAUGE, NGAUGE, NGAUGEX + integer(KIND=JPIM),ALLOCATABLE,SAVE :: WriteID(:), WriteISEQ(:) + character(len=9),ALLOCATABLE,SAVE :: WriteName(:) + real(KIND=JPRB),ALLOCATABLE,SAVE :: WriteOut(:) + + ! File IO + integer(KIND=JPIM),SAVE :: LOGOUTTXT + character(len=4),SAVE :: cYYYY + character(len=256),SAVE :: CLEN, CFMT + character(len=256),SAVE :: COUTTXT + logical,SAVE :: IsOpen + DATA IsOpen /.FALSE./ + ! ====== + IF( LOUTTXT )THEN + + IF( .not. IsOpen)THEN + IsOpen=.TRUE. + + NGAUGEX=0 + LOGOUTTXT=INQUIRE_FID() + open(LOGOUTTXT,FILE=CGAUTXT,FORM='formatted',STATUS='old') + read(LOGOUTTXT,*) NGAUGE + DO IGAUGE=1, NGAUGE + read(LOGOUTTXT,*) GID, GNAME, GIX, GIY + IF( I2VECTOR(GIX,GIY)>0 )THEN + NGAUGEX=NGAUGEX+1 + ENDIF + ENDDO + close(LOGOUTTXT) + + allocate( WriteID(NGAUGEX),WriteISEQ(NGAUGEX),WriteOut(NGAUGEX),WriteName(NGAUGEX)) + + NGAUGEX=0 + open(LOGOUTTXT,FILE=CGAUTXT,FORM='formatted',STATUS='old') + read(LOGOUTTXT,*) NGAUGE + DO IGAUGE=1, NGAUGE + read(LOGOUTTXT,*) GID, GNAME, GIX, GIY + IF( I2VECTOR(GIX,GIY)>0 )THEN + NGAUGEX=NGAUGEX+1 + WriteID(NGAUGEX) =GID + WriteName(NGAUGEX)=TRIM(GNAME) + WriteISEQ(NGAUGEX)=I2VECTOR(GIX,GIY) + ENDIF + ENDDO + close(LOGOUTTXT) + + ! ============ + write(CYYYY,'(i4.4)') ISYYYY + COUTTXT='./outtxt-'//TRIM(cYYYY)//'.txt' + + LOGOUTTXT=INQUIRE_FID() + open(LOGOUTTXT,FILE=COUTTXT,FORM='formatted') + + write(CLEN,'(i0)') NGAUGE + CFMT="(i10,"//TRIM(CLEN)//"(i10))" + write(LOGOUTTXT,CFMT) NGAUGEX, ( WriteID(IGAUGE),IGAUGE=1,NGAUGEX ) + + CFMT="(i10,"//TRIM(CLEN)//"(x,a9))" + write(LOGOUTTXT,CFMT) NGAUGEX, ( WriteName(IGAUGE),IGAUGE=1,NGAUGEX ) + + + CFMT="(i10,"//TRIM(CLEN)//"(f10.2))" + ENDIF + + DO IGAUGE=1, NGAUGEX + GISEQ=WriteISEQ(IGAUGE) + WriteOut(IGAUGE) = D2OUTFLW(GISEQ,1) + ENDDO + + write(LOGOUTTXT,CFMT) IYYYYMMDD, ( WriteOUT(IGAUGE),IGAUGE=1,NGAUGEX ) - WRITE(CLEN,'(i0)') NGAUGE - CFMT="(i10,"//TRIM(CLEN)//"(i10))" - WRITE(LOGOUTTXT,CFMT) NGAUGEX, ( WriteID(IGAUGE),IGAUGE=1,NGAUGEX ) - - CFMT="(i10,"//TRIM(CLEN)//"(x,a9))" - WRITE(LOGOUTTXT,CFMT) NGAUGEX, ( WriteName(IGAUGE),IGAUGE=1,NGAUGEX ) - - - CFMT="(i10,"//TRIM(CLEN)//"(f10.2))" - ENDIF - - DO IGAUGE=1, NGAUGEX - GISEQ=WriteISEQ(IGAUGE) - WriteOut(IGAUGE) = D2OUTFLW(GISEQ,1) - END DO - - WRITE(LOGOUTTXT,CFMT) IYYYYMMDD, ( WriteOUT(IGAUGE),IGAUGE=1,NGAUGEX ) - -ENDIF + ENDIF -END SUBROUTINE CMF_OUTTXT_WRTE -!#################################################################### + END SUBROUTINE CMF_OUTTXT_WRTE + !#################################################################### END MODULE CMF_CTRL_OUTPUT_MOD diff --git a/CaMa/src/cmf_ctrl_physics_mod.F90 b/CaMa/src/cmf_ctrl_physics_mod.F90 index 9530b602..291803b8 100755 --- a/CaMa/src/cmf_ctrl_physics_mod.F90 +++ b/CaMa/src/cmf_ctrl_physics_mod.F90 @@ -1,6 +1,6 @@ MODULE CMF_CTRL_PHYSICS_MOD !========================================================== -!* PURPOSE: call CaMa-Flood physics +!* PURPOSE: CALL CaMa-Flood physics ! ! (C) D.Yamazaki & E. Dutra (U-Tokyo/FCUL) Aug 2019 ! @@ -18,261 +18,254 @@ MODULE CMF_CTRL_PHYSICS_MOD ! -- CMF_PHYSICS_FLDSTG ! -- !#################################################################### -SUBROUTINE CMF_PHYSICS_ADVANCE -USE PARKIND1, ONLY: JPIM, JPRB, JPRD, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM, DT, LADPSTP -USE YOS_CMF_INPUT, ONLY: LKINE, LSLPMIX, LFLDOUT, LPTHOUT, LDAMOUT, LLEVEE, LOUTINS -USE YOS_CMF_PROG, ONLY: D2FLDOUT, D2FLDOUT_PRE -! -USE CMF_CALC_OUTFLW_MOD, ONLY: CMF_CALC_OUTFLW, CMF_CALC_INFLOW -USE CMF_CALC_PTHOUT_MOD, ONLY: CMF_CALC_PTHOUT -USE CMF_CALC_STONXT_MOD, ONLY: CMF_CALC_STONXT -USE CMF_CALC_DIAG_MOD, ONLY: CMF_DIAG_AVEMAX -! optional -USE CMF_OPT_OUTFLW_MOD, ONLY: CMF_CALC_OUTFLW_KINEMIX, CMF_CALC_OUTFLW_KINE,CMF_CALC_OUTINS -USE CMF_CTRL_DAMOUT_MOD, ONLY: CMF_DAMOUT_CALC, CMF_DAMOUT_WATBAL, CMF_DAMOUT_WRTE -USE CMF_CTRL_LEVEE_MOD, ONLY: CMF_LEVEE_OPT_PTHOUT + SUBROUTINE CMF_PHYSICS_ADVANCE + USE PARKIND1, only: JPIM, JPRB, JPRD, JPRM + USE YOS_CMF_INPUT, only: LOGNAM, DT, LADPSTP + USE YOS_CMF_INPUT, only: LKINE, LSLPMIX, LFLDOUT, LPTHOUT, LDAMOUT, LLEVEE, LOUTINS + USE YOS_CMF_PROG, only: D2FLDOUT, D2FLDOUT_PRE + ! + USE CMF_CALC_OUTFLW_MOD, only: CMF_CALC_OUTFLW, CMF_CALC_INFLOW + USE CMF_CALC_PTHOUT_MOD, only: CMF_CALC_PTHOUT + USE CMF_CALC_STONXT_MOD, only: CMF_CALC_STONXT + USE CMF_CALC_DIAG_MOD, only: CMF_DIAG_AVEMAX + ! optional + USE CMF_OPT_OUTFLW_MOD, only: CMF_CALC_OUTFLW_KINEMIX, CMF_CALC_OUTFLW_KINE,CMF_CALC_OUTINS + USE CMF_CTRL_DAMOUT_MOD, only: CMF_DAMOUT_CALC, CMF_DAMOUT_WATBAL, CMF_DAMOUT_WRTE + USE CMF_CTRL_LEVEE_MOD, only: CMF_LEVEE_OPT_PTHOUT #ifdef ILS -USE YOS_CMF_ICI, ONLY: LLAKEIN -USE CMF_CALC_LAKEIN_MOD, ONLY: CMF_CALC_LAKEIN, CMF_LAKEIN_AVE + USE YOS_CMF_ICI, only: LLAKEIN + USE CMF_CALC_LAKEIN_MOD, only: CMF_CALC_LAKEIN, CMF_LAKEIN_AVE #endif -IMPLICIT NONE -!! LOCAL -INTEGER(KIND=JPIM) :: IT, NT -REAL(KIND=JPRB) :: DT_DEF -!================================================ -DT_DEF=DT - -!=== 0. calculate river and floodplain stage (for DT calc & ) -CALL CMF_PHYSICS_FLDSTG - -NT=1 -IF( LADPSTP )THEN ! adoptive time step - CALL CALC_ADPSTP -ENDIF - -!! ========== -DO IT=1, NT - -!=== 1. Calculate river discharge - IF ( LKINE ) THEN - CALL CMF_CALC_OUTFLW_KINE !! OPTION: kinematic - ELSEIF( LSLPMIX ) THEN - CALL CMF_CALC_OUTFLW_KINEMIX !! OPTION: mix local-inertial & kinematic based on slope - ELSE - CALL CMF_CALC_OUTFLW !! Default: Local inertial - ENDIF - - IF( .not. LFLDOUT )THEN - D2FLDOUT(:,:)=0._JPRB !! OPTION: no high-water channel flow - D2FLDOUT_PRE(:,:)=0._JPRB - ENDIF - -! --- v4.12: damout before pthout for water buget error - IF ( LDAMOUT ) THEN - CALL CMF_DAMOUT_CALC !! reservoir operation - ENDIF - -! --- Water budget adjustment and calculate inflow - CALL CMF_CALC_INFLOW - IF ( LDAMOUT ) THEN - CALL CMF_DAMOUT_WATBAL !! reservoir operation - ENDIF - -! --- Bifurcation channel flow - IF( LPTHOUT )THEN - IF( LLEVEE )THEN - CALL CMF_LEVEE_OPT_PTHOUT !! bifurcation channel flow - ELSE - CALL CMF_CALC_PTHOUT !! bifurcation channel flow - ENDIF - ENDIF - -! --- save value for next tstet - CALL CALC_VARS_PRE - -!=== 2. Calculate the storage in the next time step in FTCS diff. eq. - CALL CMF_CALC_STONXT - -!=== option for ILS coupling + IMPLICIT NONE + !! LOCAL + integer(KIND=JPIM) :: IT, NT + real(KIND=JPRB) :: DT_DEF + !================================================ + DT_DEF=DT + + !=== 0. calculate river and floodplain stage (for DT calc & ) + CALL CMF_PHYSICS_FLDSTG + + NT=1 + IF( LADPSTP )THEN ! adoptive time step + CALL CALC_ADPSTP + ENDIF + + !! ========== + DO IT=1, NT + + !=== 1. Calculate river discharge + IF ( LKINE ) THEN + CALL CMF_CALC_OUTFLW_KINE !! OPTION: kinematic + ELSEIF( LSLPMIX ) THEN + CALL CMF_CALC_OUTFLW_KINEMIX !! OPTION: mix local-inertial & kinematic based on slope + ELSE + CALL CMF_CALC_OUTFLW !! Default: Local inertial + ENDIF + + IF( .not. LFLDOUT )THEN + D2FLDOUT(:,:)=0._JPRB !! OPTION: no high-water channel flow + D2FLDOUT_PRE(:,:)=0._JPRB + ENDIF + + ! --- v4.12: damout before pthout for water buget error + IF ( LDAMOUT ) THEN + CALL CMF_DAMOUT_CALC !! reservoir operation + ENDIF + + ! --- Water budget adjustment and calculate inflow + CALL CMF_CALC_INFLOW + IF ( LDAMOUT ) THEN + CALL CMF_DAMOUT_WATBAL !! reservoir operation + ENDIF + + ! --- Bifurcation channel flow + IF( LPTHOUT )THEN + IF( LLEVEE )THEN + CALL CMF_LEVEE_OPT_PTHOUT !! bifurcation channel flow + ELSE + CALL CMF_CALC_PTHOUT !! bifurcation channel flow + ENDIF + ENDIF + + ! --- save value for next tstet + CALL CALC_VARS_PRE + + !=== 2. Calculate the storage in the next time step in FTCS diff. eq. + CALL CMF_CALC_STONXT + + !=== option for ILS coupling #ifdef ILS - IF( LLAKEIN )THEN - CALL CMF_CALC_LAKEIN !! calculate lake inflow for river-lake coupling - ENDIF + IF( LLAKEIN )THEN + CALL CMF_CALC_LAKEIN !! calculate lake inflow for river-lake coupling + ENDIF #endif -!=== 3. calculate river and floodplain staging - CALL CMF_PHYSICS_FLDSTG + !=== 3. calculate river and floodplain staging + CALL CMF_PHYSICS_FLDSTG -!=== 4. write water balance monitoring to IOFILE - CALL CALC_WATBAL(IT) + !=== 4. write water balance monitoring to IOFILE + CALL CALC_WATBAL(IT) -!=== 5. calculate averages, maximum - CALL CMF_DIAG_AVEMAX + !=== 5. calculate averages, maximum + CALL CMF_DIAG_AVEMAX !=== option for ILS coupling #ifdef ILS - IF( LLAKEIN )THEN - CALL CMF_LAKEIN_AVE - ENDIF + IF( LLAKEIN )THEN + CALL CMF_LAKEIN_AVE + ENDIF #endif -END DO -DT=DT_DEF !! reset DT - -! --- Optional: calculate instantaneous discharge (only at the end of outer time step) -IF ( LOUTINS ) THEN - CALL CMF_CALC_OUTINS !! reservoir operation -ENDIF - - -CONTAINS -!========================================================== -!+ CALC_ADPSTP -!+ CALC_WATBAL(IT) -!+ CALC_VARS_PRE -!========================================================== -SUBROUTINE CALC_ADPSTP -USE YOS_CMF_INPUT, ONLY: PGRV, PDSTMTH, PCADP -USE YOS_CMF_MAP, ONLY: D2NXTDST -USE YOS_CMF_MAP, ONLY: NSEQALL,NSEQRIV,I2MASK -USE YOS_CMF_DIAG, ONLY: D2RIVDPH + END DO + DT=DT_DEF !! reset DT + + ! --- Optional: calculate instantaneous discharge (only at the end of outer time step) + IF ( LOUTINS ) THEN + CALL CMF_CALC_OUTINS !! reservoir operation + ENDIF + + + CONTAINS + !========================================================== + !+ CALC_ADPSTP + !+ CALC_WATBAL(IT) + !+ CALC_VARS_PRE + !========================================================== + SUBROUTINE CALC_ADPSTP + USE YOS_CMF_INPUT, only: PGRV, PDSTMTH, PCADP + USE YOS_CMF_MAP, only: D2NXTDST + USE YOS_CMF_MAP, only: NSEQALL,NSEQRIV,I2MASK + USE YOS_CMF_DIAG, only: D2RIVDPH #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_ADPSTP + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_ADPSTP #endif -IMPLICIT NONE -! MPI setting -! SAVE for OpenMP -INTEGER(KIND=JPIM),SAVE :: ISEQ -REAL(KIND=JPRB),SAVE :: DT_MIN -REAL(KIND=JPRB),SAVE :: DDPH, DDST + IMPLICIT NONE + ! MPI setting + ! SAVE for OpenMP + integer(KIND=JPIM),SAVE :: ISEQ + real(KIND=JPRB),SAVE :: DT_MIN + real(KIND=JPRB),SAVE :: DDPH, DDST !$OMP THREADPRIVATE (DDPH,DDST) -!================================================ - -DT_MIN=DT_DEF + !================================================ + DT_MIN=DT_DEF !$OMP PARALLEL DO REDUCTION(MIN:DT_MIN) -DO ISEQ=1, NSEQRIV - IF( I2MASK(ISEQ,1)==0 )THEN - DDPH=MAX(D2RIVDPH(ISEQ,1),0.01_JPRB ) - DDST=D2NXTDST(ISEQ,1) - DT_MIN=min( DT_MIN, PCADP*DDST * (PGRV*DDPH)**(-0.5) ) - ENDIF -END DO + DO ISEQ=1, NSEQRIV + IF( I2MASK(ISEQ,1)==0 )THEN + DDPH=MAX(D2RIVDPH(ISEQ,1),0.01_JPRB ) + DDST=D2NXTDST(ISEQ,1) + DT_MIN=min( DT_MIN, PCADP*DDST * (PGRV*DDPH)**(-0.5) ) + ENDIF + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO REDUCTION(MIN:DT_MIN) -DO ISEQ=NSEQRIV+1, NSEQALL - IF( I2MASK(ISEQ,1)==0 )THEN - DDPH=MAX(D2RIVDPH(ISEQ,1),0.01_JPRB ) - DDST=PDSTMTH - DT_MIN=min( DT_MIN, PCADP*DDST * (PGRV*DDPH)**(-0.5) ) - ENDIF -END DO + DO ISEQ=NSEQRIV+1, NSEQALL + IF( I2MASK(ISEQ,1)==0 )THEN + DDPH=MAX(D2RIVDPH(ISEQ,1),0.01_JPRB ) + DDST=PDSTMTH + DT_MIN=min( DT_MIN, PCADP*DDST * (PGRV*DDPH)**(-0.5) ) + ENDIF + ENDDO !$OMP END PARALLEL DO !*** MPI: use same DT in all node #ifdef UseMPI_CMF -CALL CMF_MPI_ADPSTP(DT_MIN) + CALL CMF_MPI_ADPSTP(DT_MIN) #endif -!********************************* - -NT=INT( DT_DEF * DT_MIN**(-1.) -0.01 )+1 -DT=DT_DEF * REAL(NT)**(-1.) - -IF( NT>=2 ) WRITE(LOGNAM,'(A15,I4,3F10.2)') "ADPSTP: NT=",NT, DT_DEF, DT_MIN, DT - -END SUBROUTINE CALC_ADPSTP -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CALC_WATBAL(IT) -USE YOS_CMF_TIME, ONLY: KMIN -USE YOS_CMF_DIAG, ONLY: P0GLBSTOPRE, P0GLBSTONXT, P0GLBSTONEW,P0GLBRIVINF,P0GLBRIVOUT !! dischrge calculation -USE YOS_CMF_DIAG, ONLY: P0GLBSTOPRE2,P0GLBSTONEW2,P0GLBRIVSTO,P0GLBFLDSTO,P0GLBFLDARE -USE CMF_UTILS_MOD, ONLY: MIN2DATE,SPLITDATE,SPLITHOUR -IMPLICIT NONE -INTEGER(KIND=JPIM),INTENT(IN) :: IT !! step in adaptive time loop -!*** LOCAL -REAL(KIND=JPRD) :: DERROR !! water ballance error1 (discharge calculation) [m3] -REAL(KIND=JPRD) :: DERROR2 !! water ballance error2 (flood stage calculation) [m3] - -!*** local physics time -INTEGER(KIND=JPIM) :: PKMIN -INTEGER(KIND=JPIM) :: PYEAR, PMON, PDAY, PHOUR, PMIN -INTEGER(KIND=JPIM) :: PYYYYMMDD, PHHMM -!*** PARAMETER -REAL(KIND=JPRD) :: DORD -PARAMETER (DORD=1.D-9) -! ================================================ -PKMIN=INT ( KMIN + IT*DT/60_JPRB ) -CALL MIN2DATE(PKMIN,PYYYYMMDD,PHHMM) -CALL SPLITDATE(PYYYYMMDD,PYEAR,PMON,PDAY) -CALL SPLITHOUR(PHHMM,PHOUR,PMIN) - -! poisitive error when water appears from somewhere, negative error when water is lost to somewhere -DERROR = - (P0GLBSTOPRE - P0GLBSTONXT + P0GLBRIVINF - P0GLBRIVOUT ) !! flux calc budget error -DERROR2 = - (P0GLBSTOPRE2 - P0GLBSTONEW2 ) !! stage calc budget error -WRITE(LOGNAM,'(I4.4,4(A1,I2.2),I6,a6,3F12.3,G12.3,2x,2F12.3,a6, 2F12.3,G12.3,3F12.3)') & - PYEAR, '/', PMON, '/', PDAY, '_', PHOUR, ':', PMIN, IT, ' flx: ', & - P0GLBSTOPRE*DORD, P0GLBSTONXT*DORD, P0GLBSTONEW*DORD ,DERROR*DORD, P0GLBRIVINF*DORD, P0GLBRIVOUT*DORD, ' stg: ', & - P0GLBSTOPRE2*DORD,P0GLBSTONEW2*DORD,DERROR2*DORD, P0GLBRIVSTO*DORD,P0GLBFLDSTO*DORD, P0GLBFLDARE*DORD - -END SUBROUTINE CALC_WATBAL -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CALC_VARS_PRE -USE YOS_CMF_MAP, ONLY: NSEQALL -USE YOS_CMF_PROG, ONLY: D2RIVOUT, D2FLDOUT, P2FLDSTO -USE YOS_CMF_PROG, ONLY: D2RIVOUT_PRE, D2FLDOUT_PRE, D2FLDSTO_PRE, D2RIVDPH_PRE -USE YOS_CMF_DIAG, ONLY: D2RIVDPH -IMPLICIT NONE -INTEGER(KIND=JPIM),SAVE :: ISEQ -! ================================================ + !********************************* + + NT=INT( DT_DEF * DT_MIN**(-1.) -0.01 )+1 + DT=DT_DEF * real(NT)**(-1.) + + IF( NT>=2 ) write(LOGNAM,'(A15,I4,3F10.2)') "ADPSTP: NT=",NT, DT_DEF, DT_MIN, DT + + END SUBROUTINE CALC_ADPSTP + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CALC_WATBAL(IT) + USE YOS_CMF_TIME, only: KMIN + USE YOS_CMF_DIAG, only: P0GLBSTOPRE, P0GLBSTONXT, P0GLBSTONEW,P0GLBRIVINF,P0GLBRIVOUT !! dischrge calculation + USE YOS_CMF_DIAG, only: P0GLBSTOPRE2,P0GLBSTONEW2,P0GLBRIVSTO,P0GLBFLDSTO,P0GLBFLDARE + USE CMF_UTILS_MOD, only: MIN2DATE,SPLITDATE,SPLITHOUR + IMPLICIT NONE + integer(KIND=JPIM),intent(in) :: IT !! step in adaptive time loop + !*** LOCAL + real(KIND=JPRD) :: DERROR !! water ballance error1 (discharge calculation) [m3] + real(KIND=JPRD) :: DERROR2 !! water ballance error2 (flood stage calculation) [m3] + + !*** local physics time + integer(KIND=JPIM) :: PKMIN + integer(KIND=JPIM) :: PYEAR, PMON, PDAY, PHOUR, PMIN + integer(KIND=JPIM) :: PYYYYMMDD, PHHMM + !*** parameter + real(KIND=JPRD) :: DORD + parameter (DORD=1.D-9) + ! ================================================ + PKMIN=INT ( KMIN + IT*DT/60_JPRB ) + CALL MIN2DATE(PKMIN,PYYYYMMDD,PHHMM) + CALL SPLITDATE(PYYYYMMDD,PYEAR,PMON,PDAY) + CALL SPLITHOUR(PHHMM,PHOUR,PMIN) + + ! poisitive error when water appears from somewhere, negative error when water is lost to somewhere + DERROR = - (P0GLBSTOPRE - P0GLBSTONXT + P0GLBRIVINF - P0GLBRIVOUT ) !! flux calc budget error + DERROR2 = - (P0GLBSTOPRE2 - P0GLBSTONEW2 ) !! stage calc budget error + write(LOGNAM,'(I4.4,4(A1,I2.2),I6,a6,3F12.3,G12.3,2x,2F12.3,a6, 2F12.3,G12.3,3F12.3)') & + PYEAR, '/', PMON, '/', PDAY, '_', PHOUR, ':', PMIN, IT, ' flx: ', & + P0GLBSTOPRE*DORD, P0GLBSTONXT*DORD, P0GLBSTONEW*DORD ,DERROR*DORD, P0GLBRIVINF*DORD, P0GLBRIVOUT*DORD, ' stg: ', & + P0GLBSTOPRE2*DORD,P0GLBSTONEW2*DORD,DERROR2*DORD, P0GLBRIVSTO*DORD,P0GLBFLDSTO*DORD, P0GLBFLDARE*DORD + + END SUBROUTINE CALC_WATBAL + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CALC_VARS_PRE + USE YOS_CMF_MAP, only: NSEQALL + USE YOS_CMF_PROG, only: D2RIVOUT, D2FLDOUT, P2FLDSTO + USE YOS_CMF_PROG, only: D2RIVOUT_PRE, D2FLDOUT_PRE, D2FLDSTO_PRE, D2RIVDPH_PRE + USE YOS_CMF_DIAG, only: D2RIVDPH + IMPLICIT NONE + integer(KIND=JPIM),SAVE :: ISEQ + ! ================================================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL ! for river mouth - D2RIVOUT_PRE(ISEQ,1)=D2RIVOUT(ISEQ,1) !! save outflow (t) - D2RIVDPH_PRE(ISEQ,1)=D2RIVDPH(ISEQ,1) !! save depth (t) - D2FLDOUT_PRE(ISEQ,1)=D2FLDOUT(ISEQ,1) !! save outflow (t) - D2FLDSTO_PRE(ISEQ,1)=P2FLDSTO(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL ! for river mouth + D2RIVOUT_PRE(ISEQ,1)=D2RIVOUT(ISEQ,1) !! save outflow (t) + D2RIVDPH_PRE(ISEQ,1)=D2RIVDPH(ISEQ,1) !! save depth (t) + D2FLDOUT_PRE(ISEQ,1)=D2FLDOUT(ISEQ,1) !! save outflow (t) + D2FLDSTO_PRE(ISEQ,1)=P2FLDSTO(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CALC_VARS_PRE -!========================================================== - -END SUBROUTINE CMF_PHYSICS_ADVANCE -!############################################################### - - - - - -!############################################################### -SUBROUTINE CMF_PHYSICS_FLDSTG -! flood stage scheme selecter -USE YOS_CMF_INPUT, ONLY: LLEVEE, LSTG_ES -USE CMF_CALC_FLDSTG_MOD,ONLY: CMF_CALC_FLDSTG_DEF, CMF_OPT_FLDSTG_ES -USE CMF_CTRL_LEVEE_MOD, ONLY: CMF_LEVEE_FLDSTG -IMPLICIT NONE - -IF( LLEVEE )THEN - CALL CMF_LEVEE_FLDSTG !! levee floodstage (Vector processor option not available) -ELSE - IF( LSTG_ES )THEN - CALL CMF_OPT_FLDSTG_ES !! Alternative subroutine optimized for vector processor - ELSE - CALL CMF_CALC_FLDSTG_DEF !! Default - ENDIF -ENDIF - -END SUBROUTINE CMF_PHYSICS_FLDSTG -!############################################################### + END SUBROUTINE CALC_VARS_PRE + !========================================================== + + END SUBROUTINE CMF_PHYSICS_ADVANCE + !############################################################### + + !############################################################### + SUBROUTINE CMF_PHYSICS_FLDSTG + ! flood stage scheme selecter + USE YOS_CMF_INPUT, only: LLEVEE, LSTG_ES + USE CMF_CALC_FLDSTG_MOD,only: CMF_CALC_FLDSTG_DEF, CMF_OPT_FLDSTG_ES + USE CMF_CTRL_LEVEE_MOD, only: CMF_LEVEE_FLDSTG + IMPLICIT NONE + IF( LLEVEE )THEN + CALL CMF_LEVEE_FLDSTG !! levee floodstage (Vector processor option not available) + ELSE + IF( LSTG_ES )THEN + CALL CMF_OPT_FLDSTG_ES !! Alternative subroutine optimized for vector processor + ELSE + CALL CMF_CALC_FLDSTG_DEF !! Default + ENDIF + ENDIF + END SUBROUTINE CMF_PHYSICS_FLDSTG + !############################################################### END MODULE CMF_CTRL_PHYSICS_MOD diff --git a/CaMa/src/cmf_ctrl_restart_mod.F90 b/CaMa/src/cmf_ctrl_restart_mod.F90 index d3b7e0c2..f49b4d81 100644 --- a/CaMa/src/cmf_ctrl_restart_mod.F90 +++ b/CaMa/src/cmf_ctrl_restart_mod.F90 @@ -18,752 +18,752 @@ MODULE CMF_CTRL_RESTART_MOD !!!tentative version 7/21 ! See the License for the specific language governing permissions and limitations under the License. !========================================================== ! shared variables in module -USE PARKIND1, ONLY: JPIM, JPRB, JPRM, JPRD -USE YOS_CMF_INPUT, ONLY: LOGNAM, LSTOONLY, LDAMOUT, LLEVEE, LPTHOUT, LGDWDLY -USE YOS_CMF_INPUT, ONLY: CSUFBIN, CSUFPTH, CSUFCDF -IMPLICIT NONE -!============================ -SAVE -!*** NAMELIST/NOUTPUT/ from inputnam -CHARACTER(LEN=256) :: CRESTSTO ! input restart file name -! -CHARACTER(LEN=256) :: CRESTDIR ! output restart file directory -CHARACTER(LEN=256) :: CVNREST ! output restart prefix -LOGICAL :: LRESTCDF ! true: netCDF restart file -LOGICAL :: LRESTDBL ! true: binary restart in double precision -INTEGER(KIND=JPIM) :: IFRQ_RST ! 0: only at last time, (1,2,3,...,24) hourly restart, 30: monthly restart -! -NAMELIST/NRESTART/ CRESTSTO,CRESTDIR,CVNREST,LRESTCDF,LRESTDBL,IFRQ_RST -! + USE PARKIND1, only: JPIM, JPRB, JPRM, JPRD + USE YOS_CMF_INPUT, only: LOGNAM, LSTOONLY, LDAMOUT, LLEVEE, LPTHOUT, LGDWDLY + USE YOS_CMF_INPUT, only: CSUFBIN, CSUFPTH, CSUFCDF + IMPLICIT NONE + !============================ + SAVE + !*** NAMELIST/NOUTPUT/ from inputnam + character(LEN=256) :: CRESTSTO ! input restart file name + ! + character(LEN=256) :: CRESTDIR ! output restart file directory + character(LEN=256) :: CVNREST ! output restart prefix + logical :: LRESTCDF ! true: netCDF restart file + logical :: LRESTDBL ! true: binary restart in double precision + integer(KIND=JPIM) :: IFRQ_RST ! 0: only at last time, (1,2,3,...,24) hourly restart, 30: monthly restart + ! + NAMELIST/NRESTART/ CRESTSTO,CRESTDIR,CVNREST,LRESTCDF,LRESTDBL,IFRQ_RST + ! CONTAINS -!#################################################################### -!! changed 12/12 -! -- CMF_RESTART_NMLIST : set restart configulation info from namelist -! -- CMF_RESTART_INIT : Read restart file -! -- CMF_RESTART_WRITE : Write restart file -!#################################################################### -SUBROUTINE CMF_RESTART_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 1. open namelist -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::RESTART_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE - -!*** 2. default value -CRESTSTO="restart" ! input restart file name -! -CRESTDIR="./" ! output restart file directory -CVNREST ="restart" ! output restart file prefix -LRESTCDF=.FALSE. ! true: netCDF restart file -LRESTDBL=.TRUE. ! true: binary restart double precision -IFRQ_RST=0 ! 0: only end of simulation, [1,2,3,6,12,24] at selected hour, 30: monthly - -!*** 3. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NRESTART) - -!WRITE(LOGNAM,*) "=== NAMELIST, NRESTART ===" -!WRITE(LOGNAM,*) "CRESTSTO: ", TRIM(CRESTSTO) -!WRITE(LOGNAM,*) "CRESTDIR: ", TRIM(CRESTDIR) -!WRITE(LOGNAM,*) "CVNREST: ", TRIM(CVNREST) -!WRITE(LOGNAM,*) "LRESTCDF: ", LRESTCDF -!WRITE(LOGNAM,*) "LRESTDBL: ", LRESTDBL -!WRITE(LOGNAM,*) "IFRQ_RST: ", IFRQ_RST - -CLOSE(NSETFILE) - -END SUBROUTINE CMF_RESTART_NMLIST -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_RESTART_INIT -! read restart file -! -- call from CMF_DRV_INIT -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, D2RIVOUT, D2FLDOUT, P2GDWSTO, & - & D2RIVOUT_PRE,D2FLDOUT_PRE,D2RIVDPH_PRE,D2FLDSTO_PRE,& - & D1PTHFLW, D1PTHFLW_PRE, & - & P2DAMSTO, P2LEVSTO !!! added -IMPLICIT NONE -! =========== -P2RIVSTO(:,:)=0._JPRD -P2FLDSTO(:,:)=0._JPRD -D2RIVOUT(:,:)=0._JPRB -D2FLDOUT(:,:)=0._JPRB - -D2RIVOUT_PRE(:,:)=0._JPRB -D2FLDOUT_PRE(:,:)=0._JPRB -D2RIVDPH_PRE(:,:)=0._JPRB -D2FLDSTO_PRE(:,:)=0._JPRB - -IF( LPTHOUT )THEN - D1PTHFLW(:,:)=0._JPRB - D1PTHFLW_PRE(:,:)=0._JPRB -ENDIF -IF( LDAMOUT ) then - P2DAMSTO(:,:)=0._JPRD !!! added LDAMOUT -ENDIF -IF( LLEVEE ) then - P2LEVSTO(:,:)=0._JPRD !!! added LLEVEE -ENDIF -IF( LGDWDLY ) then - P2GDWSTO(:,:)=0._JPRD -ENDIF - -IF ( LRESTCDF ) THEN - CALL READ_REST_CDF -ELSE - CALL READ_REST_BIN -ENDIF - -IF( LSTOONLY )THEN !! storage only restart - D2FLDSTO_PRE(:,:)=P2FLDSTO(:,:) -ENDIF - -CONTAINS -!========================================================== -!+ READ_REST_BIN -!+ READ_REST_CDF -!+ -!========================================================== -SUBROUTINE READ_REST_BIN -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX,NY -USE YOS_CMF_MAP, ONLY: NSEQMAX,NPTHOUT, NPTHLEV -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID, mapR2vecD -IMPLICIT NONE -!*** LOCAL -INTEGER(KIND=JPIM) :: RIREC -REAL(KIND=JPRD) :: P2VEC(NSEQMAX,1) -REAL(KIND=JPRM) :: R1PTH(NPTHOUT,NPTHLEV) -REAL(KIND=JPRD) :: P1PTH(NPTHOUT,NPTHLEV) -CHARACTER(LEN=256) :: CFILE -!================================================ -CFILE=TRIM(CRESTSTO) -WRITE(LOGNAM,*)'READ_REST: read restart binary: ', TRIM(CFILE) - -TMPNAM=INQUIRE_FID() - -IF( LRESTDBL )THEN - OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NX*NY) -ELSE - OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -ENDIF - -RIREC=0 -CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - P2RIVSTO=P2VEC -CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - P2FLDSTO=P2VEC - -!! additional restart data for optional schemes -IF ( .not. LSTOONLY )THEN !! default restart with previous t-step outflw - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - D2RIVOUT_PRE=P2VEC - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - D2FLDOUT_PRE=P2VEC - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - D2RIVDPH_PRE=P2VEC - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - D2FLDSTO_PRE=P2VEC -ENDIF -IF ( LGDWDLY ) THEN - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - P2GDWSTO=P2VEC -ENDIF -IF ( LDAMOUT ) THEN !!! added LDAMOUT - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - P2DAMSTO=P2VEC -ENDIF -IF ( LLEVEE ) THEN !!! added LLEVEE - CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) - P2LEVSTO=P2VEC -ENDIF -CLOSE(TMPNAM) - -IF( LPTHOUT )THEN - IF( .not. LSTOONLY )THEN - CFILE=TRIM(CRESTSTO)//'.pth' - WRITE(LOGNAM,*)'READ_REST: read restart binary: ', TRIM(CFILE) - - IF( LRESTDBL )THEN - OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NPTHOUT*NPTHLEV) - READ(TMPNAM,REC=1) P1PTH - CLOSE(TMPNAM) - D1PTHFLW_PRE(:,:)=P1PTH(:,:) - ELSE - OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NPTHOUT*NPTHLEV) - READ(TMPNAM,REC=1) R1PTH - CLOSE(TMPNAM) - D1PTHFLW_PRE(:,:)=R1PTH(:,:) - ENDIF - ELSE - D1PTHFLW_PRE(:,:)=0._JPRB - ENDIF -ENDIF - -END SUBROUTINE READ_REST_BIN - -SUBROUTINE READ_BIN_MAP(P2VAR,TNAM,IREC) -USE CMF_UTILS_MOD, ONLY: mapP2vecP -USE YOS_CMF_INPUT, ONLY: NX, NY -USE YOS_CMF_MAP, ONLY: NSEQMAX -IMPLICIT NONE -REAL(KIND=JPRD) :: P2VAR(NSEQMAX,1) -INTEGER(KIND=JPIM) :: TNAM, IREC -!* local -REAL(KIND=JPRM) :: R2TEMP(NX,NY) -REAL(KIND=JPRD) :: P2TEMP(NX,NY) -!================= -IREC=IREC+1 - -!=== Double Precision Restart === -IF( LRESTDBL )THEN - READ(TNAM,REC=IREC) P2TEMP -!=== Single Precision Restart (convert to double precision once) === -ELSE - READ(TNAM,REC=IREC) R2TEMP - P2TEMP=R2TEMP -ENDIF -CALL mapP2vecP(P2TEMP,P2VAR) - -!================= -END SUBROUTINE READ_BIN_MAP -!====== -!+ -!+ -!+ -!========================================================== -SUBROUTINE READ_REST_CDF + !#################################################################### + !! changed 12/12 + ! -- CMF_RESTART_NMLIST : set restart configulation info from namelist + ! -- CMF_RESTART_INIT : Read restart file + ! -- CMF_RESTART_WRITE : Write restart file + !#################################################################### + SUBROUTINE CMF_RESTART_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 1. open namelist + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::RESTART_NMLIST: namelist open in unit: ", TRIM(CSETFILE), NSETFILE + + !*** 2. default value + CRESTSTO="restart" ! input restart file name + ! + CRESTDIR="./" ! output restart file directory + CVNREST ="restart" ! output restart file prefix + LRESTCDF=.FALSE. ! true: netCDF restart file + LRESTDBL=.TRUE. ! true: binary restart double precision + IFRQ_RST=0 ! 0: only end of simulation, [1,2,3,6,12,24] at selected hour, 30: monthly + + !*** 3. read namelist + REWIND(NSETFILE) + READ(NSETFILE,NML=NRESTART) + + !write(LOGNAM,*) "=== NAMELIST, NRESTART ===" + !write(LOGNAM,*) "CRESTSTO: ", TRIM(CRESTSTO) + !write(LOGNAM,*) "CRESTDIR: ", TRIM(CRESTDIR) + !write(LOGNAM,*) "CVNREST: ", TRIM(CVNREST) + !write(LOGNAM,*) "LRESTCDF: ", LRESTCDF + !write(LOGNAM,*) "LRESTDBL: ", LRESTDBL + !write(LOGNAM,*) "IFRQ_RST: ", IFRQ_RST + + close(NSETFILE) + + END SUBROUTINE CMF_RESTART_NMLIST + !#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_RESTART_INIT + ! read restart file + ! -- call from CMF_DRV_INIT + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, D2RIVOUT, D2FLDOUT, P2GDWSTO, & + & D2RIVOUT_PRE,D2FLDOUT_PRE,D2RIVDPH_PRE,D2FLDSTO_PRE,& + & D1PTHFLW, D1PTHFLW_PRE, & + & P2DAMSTO, P2LEVSTO !!! added + IMPLICIT NONE + ! =========== + P2RIVSTO(:,:)=0._JPRD + P2FLDSTO(:,:)=0._JPRD + D2RIVOUT(:,:)=0._JPRB + D2FLDOUT(:,:)=0._JPRB + + D2RIVOUT_PRE(:,:)=0._JPRB + D2FLDOUT_PRE(:,:)=0._JPRB + D2RIVDPH_PRE(:,:)=0._JPRB + D2FLDSTO_PRE(:,:)=0._JPRB + + IF( LPTHOUT )THEN + D1PTHFLW(:,:)=0._JPRB + D1PTHFLW_PRE(:,:)=0._JPRB + ENDIF + IF( LDAMOUT ) THEN + P2DAMSTO(:,:)=0._JPRD !!! added LDAMOUT + ENDIF + IF( LLEVEE ) THEN + P2LEVSTO(:,:)=0._JPRD !!! added LLEVEE + ENDIF + IF( LGDWDLY ) THEN + P2GDWSTO(:,:)=0._JPRD + ENDIF + + IF ( LRESTCDF ) THEN + CALL READ_REST_CDF + ELSE + CALL READ_REST_BIN + ENDIF + + IF( LSTOONLY )THEN !! storage only restart + D2FLDSTO_PRE(:,:)=P2FLDSTO(:,:) + ENDIF + + CONTAINS + !========================================================== + !+ READ_REST_BIN + !+ READ_REST_CDF + !+ + !========================================================== + SUBROUTINE READ_REST_BIN + USE YOS_CMF_INPUT, only: TMPNAM, NX,NY + USE YOS_CMF_MAP, only: NSEQMAX,NPTHOUT, NPTHLEV + USE CMF_UTILS_MOD, only: INQUIRE_FID, mapR2vecD + IMPLICIT NONE + !*** LOCAL + integer(KIND=JPIM) :: RIREC + real(KIND=JPRD) :: P2VEC(NSEQMAX,1) + real(KIND=JPRM) :: R1PTH(NPTHOUT,NPTHLEV) + real(KIND=JPRD) :: P1PTH(NPTHOUT,NPTHLEV) + character(LEN=256) :: CFILE + !================================================ + CFILE=TRIM(CRESTSTO) + write(LOGNAM,*)'READ_REST: read restart binary: ', TRIM(CFILE) + + TMPNAM=INQUIRE_FID() + + IF( LRESTDBL )THEN + open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NX*NY) + ELSE + open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + ENDIF + + RIREC=0 + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + P2RIVSTO=P2VEC + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + P2FLDSTO=P2VEC + + !! additional restart data for optional schemes + IF ( .not. LSTOONLY )THEN !! default restart with previous t-step outflw + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + D2RIVOUT_PRE=P2VEC + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + D2FLDOUT_PRE=P2VEC + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + D2RIVDPH_PRE=P2VEC + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + D2FLDSTO_PRE=P2VEC + ENDIF + IF ( LGDWDLY ) THEN + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + P2GDWSTO=P2VEC + ENDIF + IF ( LDAMOUT ) THEN !!! added LDAMOUT + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + P2DAMSTO=P2VEC + ENDIF + IF ( LLEVEE ) THEN !!! added LLEVEE + CALL READ_BIN_MAP(P2VEC,TMPNAM,RIREC) + P2LEVSTO=P2VEC + ENDIF + close(TMPNAM) + + IF( LPTHOUT )THEN + IF( .not. LSTOONLY )THEN + CFILE=TRIM(CRESTSTO)//'.pth' + write(LOGNAM,*)'READ_REST: read restart binary: ', TRIM(CFILE) + + IF( LRESTDBL )THEN + open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NPTHOUT*NPTHLEV) + read(TMPNAM,REC=1) P1PTH + close(TMPNAM) + D1PTHFLW_PRE(:,:)=P1PTH(:,:) + ELSE + open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NPTHOUT*NPTHLEV) + read(TMPNAM,REC=1) R1PTH + close(TMPNAM) + D1PTHFLW_PRE(:,:)=R1PTH(:,:) + ENDIF + ELSE + D1PTHFLW_PRE(:,:)=0._JPRB + ENDIF + ENDIF + + END SUBROUTINE READ_REST_BIN + + SUBROUTINE READ_BIN_MAP(P2VAR,TNAM,IREC) + USE CMF_UTILS_MOD, only: mapP2vecP + USE YOS_CMF_INPUT, only: NX, NY + USE YOS_CMF_MAP, only: NSEQMAX + IMPLICIT NONE + real(KIND=JPRD) :: P2VAR(NSEQMAX,1) + integer(KIND=JPIM) :: TNAM, IREC + !* local + real(KIND=JPRM) :: R2TEMP(NX,NY) + real(KIND=JPRD) :: P2TEMP(NX,NY) + !================= + IREC=IREC+1 + + !=== Double Precision Restart === + IF( LRESTDBL )THEN + read(TNAM,REC=IREC) P2TEMP + !=== Single Precision Restart (convert to double precision once) === + ELSE + read(TNAM,REC=IREC) R2TEMP + P2TEMP=R2TEMP + ENDIF + CALL mapP2vecP(P2TEMP,P2VAR) + + !================= + END SUBROUTINE READ_BIN_MAP + !====== + !+ + !+ + !+ + !========================================================== + SUBROUTINE READ_REST_CDF #ifdef UseCDF_CMF -USE NETCDF -USE YOS_CMF_INPUT, ONLY: NX, NY -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN -USE CMF_UTILS_MOD, ONLY: NCERROR, mapP2vecP, mapP2vecD -IMPLICIT NONE -! local variables -INTEGER(KIND=JPIM) :: NCID,VARID -INTEGER(KIND=JPIM) :: IPTH -CHARACTER(LEN=256) :: CFILE -REAL(KIND=JPRD) :: P2TEMP(NX,NY), P1PTH(NPTHOUT,NPTHLEV) !! NetCDF restart is in Double Precision -!================================================ -CFILE=TRIM(CRESTSTO) -WRITE(LOGNAM,*)'READ_REST: read restart netcdf: ', TRIM(CFILE) - -CALL NCERROR( NF90_OPEN(CFILE,NF90_NOWRITE,NCID), 'OPENING '//CFILE) - -CALL NCERROR( NF90_INQ_VARID(NCID,'rivsto',VARID)) -CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) -CALL mapP2vecP(P2TEMP,P2RIVSTO) - -CALL NCERROR( NF90_INQ_VARID(NCID,'fldsto',VARID)) -CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) -CALL mapP2vecP(P2TEMP,P2FLDSTO) - - -IF( .NOT. LSTOONLY )THEN - CALL NCERROR( NF90_INQ_VARID(NCID,'rivout_pre',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecD(P2TEMP,D2RIVOUT_PRE) - D2RIVOUT=D2RIVOUT_PRE - - CALL NCERROR( NF90_INQ_VARID(NCID,'fldout_pre',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecD(P2TEMP,D2FLDOUT_PRE) - D2FLDOUT=D2FLDOUT_PRE - - CALL NCERROR( NF90_INQ_VARID(NCID,'rivdph_pre',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecD(P2TEMP,D2RIVDPH_PRE) - - CALL NCERROR( NF90_INQ_VARID(NCID,'fldsto_pre',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecD(P2TEMP,D2FLDSTO_PRE) -ENDIF - -IF ( LGDWDLY ) THEN - CALL NCERROR( NF90_INQ_VARID(NCID,'gdwsto',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecP(P2TEMP,P2GDWSTO) -ENDIF - -IF ( LDAMOUT ) THEN !!! added - CALL NCERROR( NF90_INQ_VARID(NCID,'damsto',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecP(P2TEMP,P2DAMSTO) -ENDIF - -IF ( LLEVEE ) THEN !!! added - CALL NCERROR( NF90_INQ_VARID(NCID,'levsto',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) - CALL mapP2vecP(P2TEMP,P2LEVSTO) -ENDIF - -IF ( LPTHOUT .AND. .NOT. LSTOONLY ) THEN - CALL NCERROR( NF90_INQ_VARID(NCID,'pthflw_pre',VARID)) - CALL NCERROR( NF90_GET_VAR(NCID,VARID,P1PTH,(/1,1,1/),(/NPTHOUT,NPTHLEV,1/) ) ) - DO IPTH=1,NPTHOUT - IF (PTH_UPST(IPTH)>0 .AND. PTH_DOWN(IPTH)>0 ) THEN - D1PTHFLW_PRE(IPTH,:)=P1PTH(IPTH,:) - ELSE - D1PTHFLW_PRE(IPTH,:)=0._JPRB - ENDIF - END DO -ENDIF - -CALL NCERROR( NF90_CLOSE(NCID) ) + USE NETCDF + USE YOS_CMF_INPUT, only: NX, NY + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN + USE CMF_UTILS_MOD, only: NCERROR, mapP2vecP, mapP2vecD + IMPLICIT NONE + ! local variables + integer(KIND=JPIM) :: NCID,VARID + integer(KIND=JPIM) :: IPTH + character(LEN=256) :: CFILE + real(KIND=JPRD) :: P2TEMP(NX,NY), P1PTH(NPTHOUT,NPTHLEV) !! NetCDF restart is in Double Precision + !================================================ + CFILE=TRIM(CRESTSTO) + write(LOGNAM,*)'READ_REST: read restart netcdf: ', TRIM(CFILE) + + CALL NCERROR( NF90_OPEN(CFILE,NF90_NOWRITE,NCID), 'OPENING '//CFILE) + + CALL NCERROR( NF90_INQ_VARID(NCID,'rivsto',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecP(P2TEMP,P2RIVSTO) + + CALL NCERROR( NF90_INQ_VARID(NCID,'fldsto',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecP(P2TEMP,P2FLDSTO) + + + IF( .not. LSTOONLY )THEN + CALL NCERROR( NF90_INQ_VARID(NCID,'rivout_pre',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecD(P2TEMP,D2RIVOUT_PRE) + D2RIVOUT=D2RIVOUT_PRE + + CALL NCERROR( NF90_INQ_VARID(NCID,'fldout_pre',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecD(P2TEMP,D2FLDOUT_PRE) + D2FLDOUT=D2FLDOUT_PRE + + CALL NCERROR( NF90_INQ_VARID(NCID,'rivdph_pre',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecD(P2TEMP,D2RIVDPH_PRE) + + CALL NCERROR( NF90_INQ_VARID(NCID,'fldsto_pre',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecD(P2TEMP,D2FLDSTO_PRE) + ENDIF + + IF ( LGDWDLY ) THEN + CALL NCERROR( NF90_INQ_VARID(NCID,'gdwsto',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecP(P2TEMP,P2GDWSTO) + ENDIF + + IF ( LDAMOUT ) THEN !!! added + CALL NCERROR( NF90_INQ_VARID(NCID,'damsto',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecP(P2TEMP,P2DAMSTO) + ENDIF + + IF ( LLEVEE ) THEN !!! added + CALL NCERROR( NF90_INQ_VARID(NCID,'levsto',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/) ) ) + CALL mapP2vecP(P2TEMP,P2LEVSTO) + ENDIF + + IF ( LPTHOUT .and. .not. LSTOONLY ) THEN + CALL NCERROR( NF90_INQ_VARID(NCID,'pthflw_pre',VARID)) + CALL NCERROR( NF90_GET_VAR(NCID,VARID,P1PTH,(/1,1,1/),(/NPTHOUT,NPTHLEV,1/) ) ) + DO IPTH=1,NPTHOUT + IF (PTH_UPST(IPTH)>0 .and. PTH_DOWN(IPTH)>0 ) THEN + D1PTHFLW_PRE(IPTH,:)=P1PTH(IPTH,:) + ELSE + D1PTHFLW_PRE(IPTH,:)=0._JPRB + ENDIF + ENDDO + ENDIF + + CALL NCERROR( NF90_CLOSE(NCID) ) #endif -END SUBROUTINE READ_REST_CDF -!========================================================== - -END SUBROUTINE CMF_RESTART_INIT -!#################################################################### + END SUBROUTINE READ_REST_CDF + !========================================================== + END SUBROUTINE CMF_RESTART_INIT + !#################################################################### -!#################################################################### -SUBROUTINE CMF_RESTART_WRITE -! write restart files -! -- called CMF_from DRV_ADVANCE -USE YOS_CMF_INPUT, ONLY: TMPNAM, NX, NY -USE YOS_CMF_TIME, ONLY: KSTEP, NSTEPS, JYYYYMMDD, JHHMM, JDD, JHOUR, JMIN -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV -USE YOS_CMF_PROG, ONLY: P2RIVSTO, P2FLDSTO, D2RIVOUT_PRE,D2FLDOUT_PRE, & - & D1PTHFLW_PRE,D2RIVDPH_PRE,D2FLDSTO_PRE,P2GDWSTO, & - & P2DAMSTO, P2LEVSTO -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!* local variable -!INTEGER(KIND=JPIM) :: IREST -!================================================ -!IREST=0 -!IF ( IFRQ_RST>=0 .and. KSTEP==NSTEPS )THEN !! end of run -! IREST=1 -!ENDIF + !#################################################################### + SUBROUTINE CMF_RESTART_WRITE + ! write restart files + ! -- called CMF_from DRV_ADVANCE + USE YOS_CMF_INPUT, only: TMPNAM, NX, NY + USE YOS_CMF_TIME, only: KSTEP, NSTEPS, JYYYYMMDD, JHHMM, JDD, JHOUR, JMIN + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV + USE YOS_CMF_PROG, only: P2RIVSTO, P2FLDSTO, D2RIVOUT_PRE,D2FLDOUT_PRE, & + & D1PTHFLW_PRE,D2RIVDPH_PRE,D2FLDSTO_PRE,P2GDWSTO, & + & P2DAMSTO, P2LEVSTO + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !* local variable + !integer(KIND=JPIM) :: IREST + !================================================ + !IREST=0 -!IF ( IFRQ_RST>=1 .and. IFRQ_RST<=24 )THEN -! IF ( MOD(JHOUR,IFRQ_RST)==0 .and. JMIN==0 )THEN !! at selected hour -! IREST=1 -! ENDIF -!ENDIF + !IF ( IFRQ_RST>=0 .and. KSTEP==NSTEPS )THEN !! end of run + ! IREST=1 + !ENDIF -!IF ( IFRQ_RST==30 )THEN -! IF ( JDD==1 .and. JHOUR==0 .and. JMIN==0 )THEN !! at start of month -! IREST=1 -! ENDIF -!ENDIF + !IF ( IFRQ_RST>=1 .and. IFRQ_RST<=24 )THEN + ! IF ( MOD(JHOUR,IFRQ_RST)==0 .and. JMIN==0 )THEN !! at selected hour + ! IREST=1 + ! ENDIF + !ENDIF + !IF ( IFRQ_RST==30 )THEN + ! IF ( JDD==1 .and. JHOUR==0 .and. JMIN==0 )THEN !! at start of month + ! IREST=1 + ! ENDIF + !ENDIF -!IF( IREST==1 )THEN -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" -WRITE(LOGNAM,*) 'CMF::RESTART_WRITE: write time: ' , JYYYYMMDD, JHHMM + !IF( IREST==1 )THEN + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) 'CMF::RESTART_WRITE: write time: ' , JYYYYMMDD, JHHMM -IF( LRESTCDF )THEN - CALL WRTE_REST_CDF !! netCDF restart write -ELSE - CALL WRTE_REST_BIN -ENDIF -!END IF -CONTAINS -!========================================================== -!+ WRTE_REST_BIN -!+ WRTE_REST_CDF -!========================================================== -SUBROUTINE WRTE_REST_BIN -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JHOUR -USE YOS_CMF_MAP, ONLY: REGIONTHIS, NSEQMAX + IF( LRESTCDF )THEN + CALL WRTE_REST_CDF !! netCDF restart write + ELSE + CALL WRTE_REST_BIN + ENDIF + !END IF + + CONTAINS + !========================================================== + !+ WRTE_REST_BIN + !+ WRTE_REST_CDF + !========================================================== + SUBROUTINE WRTE_REST_BIN + USE YOS_CMF_TIME, only: JYYYYMMDD, JHOUR + USE YOS_CMF_MAP, only: REGIONTHIS, NSEQMAX #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_AllReduce_R1PTH, CMF_MPI_AllReduce_P1PTH + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R1PTH, CMF_MPI_AllReduce_P1PTH #endif -IMPLICIT NONE -! local variable -INTEGER(KIND=JPIM) :: RIREC -CHARACTER(LEN=256) :: CFILE,CDATE -REAL(KIND=JPRD) :: P2TMP(NSEQMAX,1) !! use Real*8 for code simplicity -REAL(KIND=JPRD) :: P1PTH(NPTHOUT,NPTHLEV) -REAL(KIND=JPRM) :: R1PTH(NPTHOUT,NPTHLEV) -!================================================ -!*** set file nam -WRITE(CDATE,'(I8.8,I2.2)') JYYYYMMDD,JHOUR -CFILE=TRIM(CRESTDIR)//TRIM(CVNREST)//TRIM(CDATE)//TRIM(CSUFBIN) -WRITE(LOGNAM,*) 'WRTE_REST_BIN: restart file:',CFILE - -!*** write restart data (2D map) -TMPNAM=INQUIRE_FID() - -IF( LRESTDBL )THEN - IF ( REGIONTHIS==1 ) OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NX*NY) -ELSE - IF ( REGIONTHIS==1 ) OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) -ENDIF - -RIREC=0 - P2TMP=P2RIVSTO - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - P2TMP=P2FLDSTO - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) -!!================ -!! additional restart data for optional schemes (only write required vars) - IF ( .not. LSTOONLY )THEN !! default restart with previous t-step outflw - P2TMP=D2RIVOUT_PRE - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - P2TMP=D2FLDOUT_PRE - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - P2TMP=D2RIVDPH_PRE - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - P2TMP=D2FLDSTO_PRE - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - ENDIF - - IF ( LGDWDLY ) THEN - P2TMP=P2GDWSTO - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - ENDIF - IF ( LDAMOUT ) THEN !!! ADDED - P2TMP=P2DAMSTO - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - ENDIF - IF ( LLEVEE ) THEN !!! ADDED - P2TMP=P2LEVSTO - CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) - ENDIF - -CLOSE(TMPNAM) - -!*** write restart data (1D bifucation chanenl) -IF( LPTHOUT )THEN - - CFILE=TRIM(CRESTDIR)//TRIM(CVNREST)//TRIM(CDATE)//TRIM(CSUFBIN)//'.pth' - WRITE(LOGNAM,*) 'WRTE_REST: WRITE RESTART BIN:',CFILE - - !! Double Precision Restart - IF( LRESTDBL )THEN - P1PTH(:,:)=D1PTHFLW_PRE(:,:) + IMPLICIT NONE + ! local variable + integer(KIND=JPIM) :: RIREC + character(LEN=256) :: CFILE,CDATE + real(KIND=JPRD) :: P2TMP(NSEQMAX,1) !! use Real*8 for code simplicity + real(KIND=JPRD) :: P1PTH(NPTHOUT,NPTHLEV) + real(KIND=JPRM) :: R1PTH(NPTHOUT,NPTHLEV) + !================================================ + !*** set file nam + write(CDATE,'(I8.8,I2.2)') JYYYYMMDD,JHOUR + CFILE=TRIM(CRESTDIR)//TRIM(CVNREST)//TRIM(CDATE)//TRIM(CSUFBIN) + write(LOGNAM,*) 'WRTE_REST_BIN: restart file:',CFILE + + !*** write restart data (2D map) + TMPNAM=INQUIRE_FID() + + IF( LRESTDBL )THEN + IF ( REGIONTHIS==1 ) open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NX*NY) + ELSE + IF ( REGIONTHIS==1 ) open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NX*NY) + ENDIF + + RIREC=0 + P2TMP=P2RIVSTO + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + P2TMP=P2FLDSTO + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + !!================ + !! additional restart data for optional schemes (only write required vars) + IF ( .not. LSTOONLY )THEN !! default restart with previous t-step outflw + P2TMP=D2RIVOUT_PRE + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + P2TMP=D2FLDOUT_PRE + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + P2TMP=D2RIVDPH_PRE + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + P2TMP=D2FLDSTO_PRE + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + ENDIF + + IF ( LGDWDLY ) THEN + P2TMP=P2GDWSTO + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + ENDIF + IF ( LDAMOUT ) THEN !!! ADDED + P2TMP=P2DAMSTO + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + ENDIF + IF ( LLEVEE ) THEN !!! ADDED + P2TMP=P2LEVSTO + CALL WRTE_BIN_MAP(P2TMP,TMPNAM,RIREC) + ENDIF + + close(TMPNAM) + + !*** write restart data (1D bifucation chanenl) + IF( LPTHOUT )THEN + + CFILE=TRIM(CRESTDIR)//TRIM(CVNREST)//TRIM(CDATE)//TRIM(CSUFBIN)//'.pth' + write(LOGNAM,*) 'WRTE_REST: write RESTART BIN:',CFILE + + !! Double Precision Restart + IF( LRESTDBL )THEN + P1PTH(:,:)=D1PTHFLW_PRE(:,:) #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_P1PTH(P1PTH) + CALL CMF_MPI_AllReduce_P1PTH(P1PTH) #endif - IF ( REGIONTHIS==1 )THEN - OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NPTHOUT*NPTHLEV) - WRITE(TMPNAM,REC=1) P1PTH - CLOSE(TMPNAM) - ENDIF - - !! Single Precision Restart - ELSE - R1PTH(:,:)=REAL(D1PTHFLW_PRE(:,:),4) + IF ( REGIONTHIS==1 )THEN + open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=8*NPTHOUT*NPTHLEV) + write(TMPNAM,REC=1) P1PTH + close(TMPNAM) + ENDIF + + !! Single Precision Restart + ELSE + R1PTH(:,:)=real(D1PTHFLW_PRE(:,:),4) #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_R1PTH(R1PTH) + CALL CMF_MPI_AllReduce_R1PTH(R1PTH) #endif - IF ( REGIONTHIS==1 )THEN - OPEN(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NPTHOUT*NPTHLEV) - WRITE(TMPNAM,REC=1) R1PTH - CLOSE(TMPNAM) - ENDIF - ENDIF -ENDIF - -END SUBROUTINE WRTE_REST_BIN -!================= -SUBROUTINE WRTE_BIN_MAP(P2VAR,TNAM,IREC) -USE CMF_UTILS_MOD, ONLY: vecP2mapP, vecP2mapR -USE YOS_CMF_MAP, ONLY: REGIONTHIS, NSEQMAX + IF ( REGIONTHIS==1 )THEN + open(TMPNAM,FILE=CFILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4*NPTHOUT*NPTHLEV) + write(TMPNAM,REC=1) R1PTH + close(TMPNAM) + ENDIF + ENDIF + ENDIF + + END SUBROUTINE WRTE_REST_BIN + !================= + SUBROUTINE WRTE_BIN_MAP(P2VAR,TNAM,IREC) + USE CMF_UTILS_MOD, only: vecP2mapP, vecP2mapR + USE YOS_CMF_MAP, only: REGIONTHIS, NSEQMAX #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_AllReduce_R2MAP, CMF_MPI_AllReduce_P2MAP + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R2MAP, CMF_MPI_AllReduce_P2MAP #endif -IMPLICIT NONE -REAL(KIND=JPRD) :: P2VAR(NSEQMAX,1) !! use Real*8 for code simplicity -INTEGER(KIND=JPIM) :: TNAM,IREC -!* local -REAL(KIND=JPRM) :: R2TEMP(NX,NY) -REAL(KIND=JPRD) :: P2TEMP(NX,NY) -!================= -IREC=IREC+1 - -!! Double Precision Restart -IF( LRESTDBL )THEN - CALL vecP2mapP(P2VAR,P2TEMP) + IMPLICIT NONE + real(KIND=JPRD) :: P2VAR(NSEQMAX,1) !! use Real*8 for code simplicity + integer(KIND=JPIM) :: TNAM,IREC + !* local + real(KIND=JPRM) :: R2TEMP(NX,NY) + real(KIND=JPRD) :: P2TEMP(NX,NY) + !================= + IREC=IREC+1 + + !! Double Precision Restart + IF( LRESTDBL )THEN + CALL vecP2mapP(P2VAR,P2TEMP) #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_P2MAP(P2TEMP) + CALL CMF_MPI_AllReduce_P2MAP(P2TEMP) #endif - IF ( REGIONTHIS==1 ) WRITE(TNAM,REC=IREC) P2TEMP + IF ( REGIONTHIS==1 ) write(TNAM,REC=IREC) P2TEMP -!! Single Precision Restart -ELSE - CALL vecP2mapR(P2VAR,R2TEMP) + !! Single Precision Restart + ELSE + CALL vecP2mapR(P2VAR,R2TEMP) #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_R2MAP(R2TEMP) + CALL CMF_MPI_AllReduce_R2MAP(R2TEMP) #endif - IF ( REGIONTHIS==1 ) WRITE(TNAM,REC=IREC) R2TEMP -ENDIF -!================= -END SUBROUTINE WRTE_BIN_MAP -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE WRTE_REST_CDF + IF ( REGIONTHIS==1 ) write(TNAM,REC=IREC) R2TEMP + ENDIF + !================= + END SUBROUTINE WRTE_BIN_MAP + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE WRTE_REST_CDF #ifdef UseCDF_CMF -USE NETCDF -USE YOS_CMF_INPUT, ONLY: DMIS -USE YOS_CMF_TIME, ONLY: KMINNEXT, KMINSTART, ISYYYY,ISMM,ISDD, ISHOUR, ISMIN -USE YOS_CMF_TIME, ONLY: JYYYYMMDD,JHOUR -USE YOS_CMF_MAP, ONLY: D1LON, D1LAT, REGIONTHIS, NSEQMAX -USE CMF_UTILS_MOD, ONLY: NCERROR, vecP2mapP + USE NETCDF + USE YOS_CMF_INPUT, only: DMIS + USE YOS_CMF_TIME, only: KMINNEXT, KMINSTART, ISYYYY,ISMM,ISDD, ISHOUR, ISMIN + USE YOS_CMF_TIME, only: JYYYYMMDD,JHOUR + USE YOS_CMF_MAP, only: D1LON, D1LAT, REGIONTHIS, NSEQMAX + USE CMF_UTILS_MOD, only: NCERROR, vecP2mapP #ifdef UseMPI_CMF -USE CMF_CTRL_MPI_MOD, ONLY: CMF_MPI_AllReduce_P2MAP, CMF_MPI_AllReduce_P1PTH + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_P2MAP, CMF_MPI_AllReduce_P1PTH #endif -IMPLICIT NONE -!* local variable -CHARACTER(LEN=256) :: CFILE, CDATE, CTIME, CVAR -INTEGER(KIND=JPIM) :: NCID, VARID, LATID, LONID, TIMEID, JF, & - NPTHOUTID, NPTHLEVID, STATUS, IOUT -REAL(KIND=JPRB) :: XTIME ! seconds since start of the run ! -REAL(KIND=JPRD) :: P2VEC(NSEQMAX,1), P2TEMP(NX,NY), P1PTH(NPTHOUT,NPTHLEV) -!================================================ -!*** 1. set file name & tim -XTIME=REAL( (KMINNEXT-KMINSTART),JPRB) *60._JPRB -WRITE(CTIME,'(A14,I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2)') 'seconds since ',ISYYYY,'-',ISMM,'-',ISDD,' ',ISHOUR,":",ISMIN - -WRITE(CDATE,'(I8.8,I2.2)') JYYYYMMDD,JHOUR -CFILE=TRIM(CRESTDIR)//TRIM(CVNREST)//TRIM(CDATE)//TRIM(CSUFCDF) -WRITE(LOGNAM,*) 'WRTE_REST:create RESTART NETCDF:',CFILE - -!============================ -!*** 2. create netCDF file -!! Note: all restart variables are saved as Float64. -IF( REGIONTHIS==1 )THEN !! write restart only on master node - - CALL NCERROR( NF90_CREATE(CFILE,NF90_NETCDF4,NCID),'CREATING FILE:'//TRIM(CFILE) ) - - !! dimensions - CALL NCERROR( NF90_DEF_DIM(NCID, 'time', NF90_UNLIMITED, TIMEID) ) - CALL NCERROR( NF90_DEF_DIM(NCID, 'lat', NY, LATID) ) - CALL NCERROR( NF90_DEF_DIM(NCID, 'lon', NX, LONID) ) - - IF ( LPTHOUT ) THEN - CALL NCERROR( NF90_DEF_DIM(NCID, 'NPTHOUT', NPTHOUT, NPTHOUTID) ) - CALL NCERROR( NF90_DEF_DIM(NCID, 'NPTHLEV', NPTHLEV, NPTHLEVID) ) - ENDIF - - !! dimentions - CALL NCERROR( NF90_DEF_VAR(NCID, 'lat', NF90_FLOAT, (/LATID/), VARID) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name','latitude') ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units','degrees_north') ) - - CALL NCERROR( NF90_DEF_VAR(NCID, 'lon', NF90_FLOAT, (/LONID/), VARID) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name','longitude') ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units','degrees_east') ) - - CALL NCERROR( NF90_DEF_VAR(NCID, 'time', NF90_DOUBLE, (/TIMEID/), VARID) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name','time') ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',CTIME) ) - - !! variables - CALL NCERROR( NF90_DEF_VAR(NCID, 'rivsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"river storage" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)),'in here?' ) - - - CALL NCERROR( NF90_DEF_VAR(NCID, 'fldsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"flood plain storage" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - - IF ( .not. LSTOONLY )THEN !! default restart with previous t-step outflw - CALL NCERROR( NF90_DEF_VAR(NCID, 'rivout_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/),& - VARID,DEFLATE_LEVEL=6), 'Creating Variable') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"river outflow prev" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3/s") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - - CALL NCERROR( NF90_DEF_VAR(NCID, 'fldout_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"floodplain outflow prev" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3/s") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - - CALL NCERROR( NF90_DEF_VAR(NCID, 'rivdph_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"river depth prev" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - - CALL NCERROR( NF90_DEF_VAR(NCID, 'fldsto_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"floodplain storage prev" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - - !! optional variables - IF ( LPTHOUT ) THEN - CALL NCERROR( NF90_DEF_VAR(NCID, 'pthflw_pre', NF90_DOUBLE, (/NPTHOUTID,NPTHLEVID,TIMEID/),& - VARID,DEFLATE_LEVEL=6) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"bifurcation outflow pre" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3/s") ) - ENDIF - ENDIF - - IF ( LGDWDLY ) THEN - CALL NCERROR( NF90_DEF_VAR(NCID, 'gdwsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable gdwsto') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"ground water storage" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - ENDIF - - IF ( LDAMOUT ) THEN !!! added - CALL NCERROR( NF90_DEF_VAR(NCID, 'damsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable dasmto') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"dam reservoir storage" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - ENDIF - - IF ( LLEVEE ) THEN !!! added - CALL NCERROR( NF90_DEF_VAR(NCID, 'levsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & - VARID,DEFLATE_LEVEL=6), 'Creating Variable levsto') - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"storage exceeds levee protection" ) ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) - CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',REAL(DMIS,KIND=JPRD)) ) - ENDIF - - CALL NCERROR( NF90_ENDDEF(NCID) ) - !============================ - !*** 2. write data - - !! dimentions (time,lon,lat) - CALL NCERROR( NF90_INQ_VARID(NCID,'time',VARID)) - CALL NCERROR( NF90_PUT_VAR(NCID,VARID,XTIME) ) - - CALL NCERROR ( NF90_INQ_VARID(NCID,'lon',VARID),'getting id' ) - CALL NCERROR( NF90_PUT_VAR(NCID,VARID,D1LON)) - - CALL NCERROR ( NF90_INQ_VARID(NCID,'lat',VARID),'getting id' ) - CALL NCERROR( NF90_PUT_VAR(NCID,VARID,D1LAT)) - -ENDIF !! regionthis=1: definition - -!! write restart variables (gather data in MPI mode) -DO JF=1,9 - IOUT=0 - SELECT CASE(JF) - CASE (1) - CVAR='rivsto' - CALL vecP2mapP(P2RIVSTO,P2TEMP) - IOUT=1 - CASE (2) - CVAR='fldsto' - CALL vecP2mapP(P2FLDSTO,P2TEMP) - IOUT=1 - CASE (3) - CVAR='rivout_pre' - IF( .not. LSTOONLY ) THEN - P2VEC(:,:)=D2RIVOUT_PRE(:,:) - CALL vecP2mapP(P2VEC,P2TEMP) - IOUT=1 - ENDIF - CASE (4) - CVAR='fldout_pre' - IF( .not. LSTOONLY ) THEN - P2VEC(:,:)=D2FLDOUT_PRE(:,:) - CALL vecP2mapP(P2VEC,P2TEMP) - IOUT=1 - ENDIF - CASE (5) - CVAR='rivdph_pre' - IF( .not. LSTOONLY ) THEN - P2VEC(:,:)=D2RIVDPH_PRE(:,:) - CALL vecP2mapP(P2VEC,P2TEMP) - IOUT=1 - ENDIF - CASE (6) - CVAR='fldsto_pre' - IF( .not. LSTOONLY ) THEN - P2VEC(:,:)=D2FLDSTO_PRE(:,:) - CALL vecP2mapP(P2VEC,P2TEMP) - IOUT=1 - ENDIF - CASE (7) - CVAR='gdwsto' - IF( LGDWDLY ) THEN - CALL vecP2mapP(P2GDWSTO,P2TEMP) - IOUT=1 - ENDIF - CASE (8) !!! LDAMOUT - CVAR='damsto' - IF( LDAMOUT ) THEN - CALL vecP2mapP(P2DAMSTO,P2TEMP) !! P2DAMSTO only allocated for LDAMOUT - IOUT=1 - ENDIF - CASE (9) !!! LLEVEE - CVAR='levsto' - IF( LLEVEE ) THEN - CALL vecP2mapP(P2LEVSTO,P2TEMP) !! P2DAMSTO only allocated for LDAMOUT - IOUT=1 - ENDIF - END SELECT + IMPLICIT NONE + !* local variable + character(LEN=256) :: CFILE, CDATE, CTIME, CVAR + integer(KIND=JPIM) :: NCID, VARID, LATID, LONID, TIMEID, JF, & + NPTHOUTID, NPTHLEVID, STATUS, IOUT + real(KIND=JPRB) :: XTIME ! seconds since start of the run ! + real(KIND=JPRD) :: P2VEC(NSEQMAX,1), P2TEMP(NX,NY), P1PTH(NPTHOUT,NPTHLEV) + !================================================ + !*** 1. set file name & tim + XTIME=real( (KMINNEXT-KMINSTART),JPRB) *60._JPRB + write(CTIME,'(A14,I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2)') 'seconds since ',ISYYYY,'-',ISMM,'-',ISDD,' ',ISHOUR,":",ISMIN + + write(CDATE,'(I8.8,I2.2)') JYYYYMMDD,JHOUR + CFILE=TRIM(CRESTDIR)//TRIM(CVNREST)//TRIM(CDATE)//TRIM(CSUFCDF) + write(LOGNAM,*) 'WRTE_REST:create RESTART NETCDF:',CFILE + + !============================ + !*** 2. create netCDF file + !! Note: all restart variables are saved as Float64. + IF( REGIONTHIS==1 )THEN !! write restart only on master node + + CALL NCERROR( NF90_CREATE(CFILE,NF90_NETCDF4,NCID),'CREATING FILE:'//TRIM(CFILE) ) + + !! dimensions + CALL NCERROR( NF90_DEF_DIM(NCID, 'time', NF90_UNLIMITED, TIMEID) ) + CALL NCERROR( NF90_DEF_DIM(NCID, 'lat', NY, LATID) ) + CALL NCERROR( NF90_DEF_DIM(NCID, 'lon', NX, LONID) ) + + IF ( LPTHOUT ) THEN + CALL NCERROR( NF90_DEF_DIM(NCID, 'NPTHOUT', NPTHOUT, NPTHOUTID) ) + CALL NCERROR( NF90_DEF_DIM(NCID, 'NPTHLEV', NPTHLEV, NPTHLEVID) ) + ENDIF + + !! dimentions + CALL NCERROR( NF90_DEF_VAR(NCID, 'lat', NF90_FLOAT, (/LATID/), VARID) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name','latitude') ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units','degrees_north') ) + + CALL NCERROR( NF90_DEF_VAR(NCID, 'lon', NF90_FLOAT, (/LONID/), VARID) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name','longitude') ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units','degrees_east') ) + + CALL NCERROR( NF90_DEF_VAR(NCID, 'time', NF90_DOUBLE, (/TIMEID/), VARID) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name','time') ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',CTIME) ) + + !! variables + CALL NCERROR( NF90_DEF_VAR(NCID, 'rivsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"river storage" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)),'in here?' ) + + + CALL NCERROR( NF90_DEF_VAR(NCID, 'fldsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"flood plain storage" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + + IF ( .not. LSTOONLY )THEN !! default restart with previous t-step outflw + CALL NCERROR( NF90_DEF_VAR(NCID, 'rivout_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/),& + VARID,DEFLATE_LEVEL=6), 'Creating Variable') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"river outflow prev" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3/s") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + + CALL NCERROR( NF90_DEF_VAR(NCID, 'fldout_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"floodplain outflow prev" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3/s") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + + CALL NCERROR( NF90_DEF_VAR(NCID, 'rivdph_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"river depth prev" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + + CALL NCERROR( NF90_DEF_VAR(NCID, 'fldsto_pre', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"floodplain storage prev" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + + !! optional variables + IF ( LPTHOUT ) THEN + CALL NCERROR( NF90_DEF_VAR(NCID, 'pthflw_pre', NF90_DOUBLE, (/NPTHOUTID,NPTHLEVID,TIMEID/),& + VARID,DEFLATE_LEVEL=6) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"bifurcation outflow pre" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3/s") ) + ENDIF + ENDIF + + IF ( LGDWDLY ) THEN + CALL NCERROR( NF90_DEF_VAR(NCID, 'gdwsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable gdwsto') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"ground water storage" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + ENDIF + + IF ( LDAMOUT ) THEN !!! added + CALL NCERROR( NF90_DEF_VAR(NCID, 'damsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable dasmto') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"dam reservoir storage" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + ENDIF + + IF ( LLEVEE ) THEN !!! added + CALL NCERROR( NF90_DEF_VAR(NCID, 'levsto', NF90_DOUBLE, (/LONID,LATID,TIMEID/), & + VARID,DEFLATE_LEVEL=6), 'Creating Variable levsto') + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'long_name',"storage exceeds levee protection" ) ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, 'units',"m3") ) + CALL NCERROR( NF90_PUT_ATT(NCID, VARID, '_FillValue',real(DMIS,KIND=JPRD)) ) + ENDIF + + CALL NCERROR( NF90_ENDDEF(NCID) ) + !============================ + !*** 2. write data + + !! dimentions (time,lon,lat) + CALL NCERROR( NF90_INQ_VARID(NCID,'time',VARID)) + CALL NCERROR( NF90_PUT_VAR(NCID,VARID,XTIME) ) + + CALL NCERROR ( NF90_INQ_VARID(NCID,'lon',VARID),'getting id' ) + CALL NCERROR( NF90_PUT_VAR(NCID,VARID,D1LON)) + + CALL NCERROR ( NF90_INQ_VARID(NCID,'lat',VARID),'getting id' ) + CALL NCERROR( NF90_PUT_VAR(NCID,VARID,D1LAT)) + + ENDIF !! regionthis=1: definition + + !! write restart variables (gather data in MPI mode) + DO JF=1,9 + IOUT=0 + SELECT CASE(JF) + CASE (1) + CVAR='rivsto' + CALL vecP2mapP(P2RIVSTO,P2TEMP) + IOUT=1 + CASE (2) + CVAR='fldsto' + CALL vecP2mapP(P2FLDSTO,P2TEMP) + IOUT=1 + CASE (3) + CVAR='rivout_pre' + IF( .not. LSTOONLY ) THEN + P2VEC(:,:)=D2RIVOUT_PRE(:,:) + CALL vecP2mapP(P2VEC,P2TEMP) + IOUT=1 + ENDIF + CASE (4) + CVAR='fldout_pre' + IF( .not. LSTOONLY ) THEN + P2VEC(:,:)=D2FLDOUT_PRE(:,:) + CALL vecP2mapP(P2VEC,P2TEMP) + IOUT=1 + ENDIF + CASE (5) + CVAR='rivdph_pre' + IF( .not. LSTOONLY ) THEN + P2VEC(:,:)=D2RIVDPH_PRE(:,:) + CALL vecP2mapP(P2VEC,P2TEMP) + IOUT=1 + ENDIF + CASE (6) + CVAR='fldsto_pre' + IF( .not. LSTOONLY ) THEN + P2VEC(:,:)=D2FLDSTO_PRE(:,:) + CALL vecP2mapP(P2VEC,P2TEMP) + IOUT=1 + ENDIF + CASE (7) + CVAR='gdwsto' + IF( LGDWDLY ) THEN + CALL vecP2mapP(P2GDWSTO,P2TEMP) + IOUT=1 + ENDIF + CASE (8) !!! LDAMOUT + CVAR='damsto' + IF( LDAMOUT ) THEN + CALL vecP2mapP(P2DAMSTO,P2TEMP) !! P2DAMSTO only allocated for LDAMOUT + IOUT=1 + ENDIF + CASE (9) !!! LLEVEE + CVAR='levsto' + IF( LLEVEE ) THEN + CALL vecP2mapP(P2LEVSTO,P2TEMP) !! P2DAMSTO only allocated for LDAMOUT + IOUT=1 + ENDIF + END SELECT #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_P2MAP(P2TEMP) + CALL CMF_MPI_AllReduce_P2MAP(P2TEMP) #endif - IF( IOUT==1 )THEN - IF( REGIONTHIS==1 )THEN - STATUS = NF90_INQ_VARID(NCID,TRIM(CVAR),VARID) !! check VARID is defined above, write restart only when STATUS=0 - IF ( STATUS .EQ. 0 ) THEN - CALL NCERROR( NF90_PUT_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/)) ) - ENDIF - ENDIF - ENDIF -ENDDO - -IF ( LPTHOUT ) THEN - IF ( .not. LSTOONLY )THEN - P1PTH(:,:)=D1PTHFLW_PRE(:,:) !! convert Float32 to Float64 (for Single Precison Use) + IF( IOUT==1 )THEN + IF( REGIONTHIS==1 )THEN + STATUS = NF90_INQ_VARID(NCID,TRIM(CVAR),VARID) !! check VARID is defined above, write restart only when STATUS=0 + IF ( STATUS .eq. 0 ) THEN + CALL NCERROR( NF90_PUT_VAR(NCID,VARID,P2TEMP,(/1,1,1/),(/NX,NY,1/)) ) + ENDIF + ENDIF + ENDIF + ENDDO + + IF ( LPTHOUT ) THEN + IF ( .not. LSTOONLY )THEN + P1PTH(:,:)=D1PTHFLW_PRE(:,:) !! convert Float32 to Float64 (for Single Precison Use) #ifdef UseMPI_CMF - CALL CMF_MPI_AllReduce_P1PTH(P1PTH) + CALL CMF_MPI_AllReduce_P1PTH(P1PTH) #endif - IF( REGIONTHIS==1 )THEN - CALL NCERROR( NF90_INQ_VARID(NCID,'pthflw_pre',VARID)) - CALL NCERROR( NF90_PUT_VAR(NCID,VARID,P1PTH,(/1,1,1/),(/NPTHOUT,NPTHLEV,1/)) ) - ENDIF - ENDIF -ENDIF + IF( REGIONTHIS==1 )THEN + CALL NCERROR( NF90_INQ_VARID(NCID,'pthflw_pre',VARID)) + CALL NCERROR( NF90_PUT_VAR(NCID,VARID,P1PTH,(/1,1,1/),(/NPTHOUT,NPTHLEV,1/)) ) + ENDIF + ENDIF + ENDIF -IF( REGIONTHIS==1 )THEN - CALL NCERROR( NF90_SYNC(NCID) ) - CALL NCERROR( NF90_CLOSE(NCID) ) -ENDIF + IF( REGIONTHIS==1 )THEN + CALL NCERROR( NF90_SYNC(NCID) ) + CALL NCERROR( NF90_CLOSE(NCID) ) + ENDIF -WRITE(LOGNAM,*) 'WRTE_REST: WRITE RESTART NETCDF:',CFILE + write(LOGNAM,*) 'WRTE_REST: write RESTART NETCDF:',CFILE #endif -END SUBROUTINE WRTE_REST_CDF -!========================================================== + END SUBROUTINE WRTE_REST_CDF + !========================================================== -END SUBROUTINE CMF_RESTART_WRITE -!#################################################################### + END SUBROUTINE CMF_RESTART_WRITE + !#################################################################### END MODULE CMF_CTRL_RESTART_MOD diff --git a/CaMa/src/cmf_ctrl_time_mod.F90 b/CaMa/src/cmf_ctrl_time_mod.F90 index 08b5c135..f66f4914 100755 --- a/CaMa/src/cmf_ctrl_time_mod.F90 +++ b/CaMa/src/cmf_ctrl_time_mod.F90 @@ -19,221 +19,215 @@ MODULE CMF_CTRL_TIME_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM -USE CMF_UTILS_MOD, ONLY: MIN2DATE, DATE2MIN, SPLITDATE, SPLITHOUR -!================================================ -IMPLICIT NONE -SAVE -!!=== NAMELIST/NSIMTIME/ -INTEGER(KIND=JPIM) :: SYEAR !! START YEAR -INTEGER(KIND=JPIM) :: SMON !! START MONTH -INTEGER(KIND=JPIM) :: SDAY !! START DAY -INTEGER(KIND=JPIM) :: SHOUR !! START HOUR -INTEGER(KIND=JPIM) :: EYEAR !! END YEAR -INTEGER(KIND=JPIM) :: EMON !! END MONTH -INTEGER(KIND=JPIM) :: EDAY !! END DAY -INTEGER(KIND=JPIM) :: EHOUR !! END HOUR - -NAMELIST/NSIMTIME/ SYEAR,SMON,SDAY,SHOUR, EYEAR,EMON,EDAY,EHOUR + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM + USE CMF_UTILS_MOD, only: MIN2DATE, DATE2MIN, SPLITDATE, SPLITHOUR + !================================================ + IMPLICIT NONE + SAVE + !!=== NAMELIST/NSIMTIME/ + integer(KIND=JPIM) :: SYEAR !! START YEAR + integer(KIND=JPIM) :: SMON !! START MONTH + integer(KIND=JPIM) :: SDAY !! START DAY + integer(KIND=JPIM) :: SHOUR !! START HOUR + integer(KIND=JPIM) :: EYEAR !! END YEAR + integer(KIND=JPIM) :: EMON !! END MONTH + integer(KIND=JPIM) :: EDAY !! END DAY + integer(KIND=JPIM) :: EHOUR !! END HOUR + + NAMELIST/NSIMTIME/ SYEAR,SMON,SDAY,SHOUR, EYEAR,EMON,EDAY,EHOUR CONTAINS -!#################################################################### -! -- CMF_TIME_NMLIST : Read setting from namelist -! -- CMF_TIME_INIT : Initialize time-related variables -! -- CMF_TIME_NEXT : Set next-step time-related variables -! -- CMF_TIME_UPDATE : Update time-related variables -! -!#################################################################### -SUBROUTINE CMF_TIME_NMLIST -! reed setting from namelist -! -- Called from CMF_DRV_NMLIST -!================================================ -USE YOS_CMF_INPUT, ONLY: CSETFILE,NSETFILE -USE YOS_CMF_TIME, ONLY: YYYY0, MM0, DD0 -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -!*** 0. Open namelist -NSETFILE=INQUIRE_FID() -OPEN(NSETFILE,FILE=CSETFILE,STATUS="OLD") -WRITE(LOGNAM,*) "CMF::TIME_NMLIST: namelist OPEN in unit: ", TRIM(CSETFILE), NSETFILE - -!*** 1. set default value -SYEAR=2000 -SMON=1 -SDAY=1 -SHOUR=0 -EYEAR=2001 -EMON=1 -EDAY=1 -EHOUR=0 - -!*** 2. read namelist -REWIND(NSETFILE) -READ(NSETFILE,NML=NSIMTIME) - -WRITE(LOGNAM,*) "=== NAMELIST, NSIMTIME ===" -WRITE(LOGNAM,*) "SYEAR,SMON,SDAY,SHOUR:", SYEAR,SMON,SDAY,SHOUR -WRITE(LOGNAM,*) "EYEAR,EMON,EDAY,EHOUR:", EYEAR,EMON,EDAY,EHOUR - -!*** 3. close namelist -CLOSE(NSETFILE) - -!*** 4. Define base date for KMIN calculation -YYYY0=SYEAR -MM0=1 -DD0=1 -WRITE(LOGNAM,*) "TIME_NMLIST: YYYY0 MM0 DD0 set to : ", YYYY0, MM0, DD0 - -WRITE(LOGNAM,*) "CMF::TIME_NMLIST: end: " - -END SUBROUTINE CMF_TIME_NMLIST -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_TIME_INIT -! initialize time-related valiable -! -- Called from CMF_DRV_INIT -!================================================ -USE YOS_CMF_INPUT, ONLY: DT -USE YOS_CMF_TIME, ONLY: KSTEP, NSTEPS, KMIN, KMINNEXT, KMINSTART, KMINEND -USE YOS_CMF_TIME, ONLY: ISYYYYMMDD,ISHHMM,ISYYYY,ISMM,ISDD,ISHOUR,ISMIN !! start date:hour -USE YOS_CMF_TIME, ONLY: IEYYYYMMDD,IEHHMM,IEYYYY,IEMM,IEDD,IEHOUR,IEMIN !! start date:hour -USE YOS_CMF_TIME, ONLY: IYYYYMMDD, IHHMM, IYYYY, IMM, IDD, IHOUR, IMIN !! date:hour at start of time step -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JHHMM, JYYYY, JMM, JDD, JHOUR, JMIN !! date:hour at end of time step -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -WRITE(LOGNAM,*) "CMF::TIME_INIT: initialize time variables" - -!*** 1. Start time & End Time -ISYYYYMMDD=SYEAR*10000+SMON*100+SDAY -ISHHMM=SHOUR*100_JPIM -ISYYYY=SYEAR -ISMM =SMON -ISDD =SDAY -ISHOUR=SHOUR -ISMIN =0_JPIM - -IEYYYYMMDD=EYEAR*10000+EMON*100+EDAY !! End time -IEHHMM=EHOUR*100_JPIM -IEYYYY=EYEAR -IEMM =EMON -IEDD =EDAY -IEHOUR=EHOUR -IEMIN =0_JPIM - -WRITE(LOGNAM,*) 'Start Date:',ISYYYYMMDD, ISHHMM, KMINSTART -WRITE(LOGNAM,*) 'End Date:',IEYYYYMMDD, IEHHMM, KMINEND - -!*** 2. Initialize KMIN for START & END Time -KMINSTART=DATE2MIN(ISYYYYMMDD,ISHHMM) -KMINEND =DATE2MIN(IEYYYYMMDD,IEHHMM) - -KMIN=KMINSTART - -!*** 3. Calculate NSTEPS: time steps within simulation time -KSTEP=0 -NSTEPS=int ( ( (KMINEND-KMINSTART)*60_JPIM ) / DT ) !! (End - Start) / DT - -WRITE(LOGNAM,*) 'NSTEPS :',NSTEPS - -!*** 4. Initial time step setting -IYYYYMMDD=ISYYYYMMDD -CALL SPLITDATE(IYYYYMMDD,IYYYY,IMM,IDD) -IHHMM=ISHHMM -CALL SPLITHOUR(IHHMM,IHOUR,IMIN) - -! tentatively set KMINNEXT to KMIN (just within initialization phase) -KMINNEXT =KMIN -JYYYYMMDD=IYYYYMMDD -JHHMM=IHHMM -CALL SPLITDATE(JYYYYMMDD,JYYYY,JMM,JDD) -CALL SPLITHOUR(JHHMM,JHOUR,JMIN) - -WRITE(LOGNAM,*) 'Initial Time Step Date:Hour :', IYYYYMMDD,'_',IHOUR,':',IMIN - -!*** end -WRITE(LOGNAM,*) "CMF::TIME_INIT: end" - -END SUBROUTINE CMF_TIME_INIT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_TIME_NEXT -! update time-related valiable -! -- Called from CMF_DRV_ADVANCE -!================================================ -USE YOS_CMF_INPUT, ONLY: DT -USE YOS_CMF_TIME, ONLY: KSTEP, KMIN, KMINNEXT -USE YOS_CMF_TIME, ONLY: IYYYYMMDD, IHHMM !! date:hour at start of time step -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JYYYY, JMM, JDD, JHHMM, JHOUR, JMIN !! date:hour at end of time step -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -!*** 1. Advance KMIN, KSTEP -KSTEP=KSTEP+1 -KMINNEXT=KMIN+INT(DT/60,JPIM) - -WRITE(LOGNAM,*) "CMF::TIME_NEXT: ", KSTEP, KMIN, KMINNEXT, DT - -!*** 2. Update J-time -CALL MIN2DATE(KMINNEXT,JYYYYMMDD,JHHMM) -CALL SPLITDATE(JYYYYMMDD,JYYYY,JMM,JDD) -CALL SPLITHOUR(JHHMM,JHOUR,JMIN) - -WRITE(LOGNAM,*) "Strt of Tstep: KMIN, IYYYYMMDD, IHHMM", KMIN, IYYYYMMDD, IHHMM -WRITE(LOGNAM,*) "End of Tstep: KMINNEXT, JYYYYMMDD, JHHMM", KMINNEXT, JYYYYMMDD, JHHMM - - -END SUBROUTINE CMF_TIME_NEXT -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_TIME_UPDATE -! update time-related valiable -! -- Called from CMF_DRV_ADVANCE -!================================================ -USE YOS_CMF_TIME, ONLY: KMIN, KMINNEXT -USE YOS_CMF_TIME, ONLY: IYYYYMMDD, IYYYY, IMM, IDD, IHHMM, IHOUR, IMIN !! date:hour at start of time step -USE YOS_CMF_TIME, ONLY: JYYYYMMDD, JYYYY, JMM, JDD, JHHMM, JHOUR, JMIN !! date:hour at end of time step -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "CMF_TIME_UPDATE:" -!*** 1. Advance KMIN, KSTEP -KMIN=KMINNEXT - -!*** 2. Update I-time -IYYYYMMDD=JYYYYMMDD -IYYYY=JYYYY -IMM =JMM -IDD =JDD -IHHMM=JHHMM -IHOUR=JHOUR -IMIN =JMIN - -WRITE(LOGNAM,*) "Current time update: KMIN, IYYYYMMDD, IHHMM", KMIN, IYYYYMMDD, IHHMM - -END SUBROUTINE CMF_TIME_UPDATE -!#################################################################### + !#################################################################### + ! -- CMF_TIME_NMLIST : Read setting from namelist + ! -- CMF_TIME_INIT : Initialize time-related variables + ! -- CMF_TIME_NEXT : Set next-step time-related variables + ! -- CMF_TIME_UPDATE : Update time-related variables + ! + !#################################################################### + SUBROUTINE CMF_TIME_NMLIST + ! reed setting from namelist + ! -- Called from CMF_DRV_NMLIST + !================================================ + USE YOS_CMF_INPUT, only: CSETFILE,NSETFILE + USE YOS_CMF_TIME, only: YYYY0, MM0, DD0 + USE CMF_UTILS_MOD, only: INQUIRE_FID + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + !*** 0. Open namelist + NSETFILE=INQUIRE_FID() + open(NSETFILE,FILE=CSETFILE,STATUS="OLD") + write(LOGNAM,*) "CMF::TIME_NMLIST: namelist open in unit: ", TRIM(CSETFILE), NSETFILE + + !*** 1. set default value + SYEAR=2000 + SMON=1 + SDAY=1 + SHOUR=0 + EYEAR=2001 + EMON=1 + EDAY=1 + EHOUR=0 + + !*** 2. read namelist + rewind(NSETFILE) + read(NSETFILE,NML=NSIMTIME) + + write(LOGNAM,*) "=== NAMELIST, NSIMTIME ===" + write(LOGNAM,*) "SYEAR,SMON,SDAY,SHOUR:", SYEAR,SMON,SDAY,SHOUR + write(LOGNAM,*) "EYEAR,EMON,EDAY,EHOUR:", EYEAR,EMON,EDAY,EHOUR + + !*** 3. close namelist + close(NSETFILE) + + !*** 4. Define base date for KMIN calculation + YYYY0=SYEAR + MM0=1 + DD0=1 + write(LOGNAM,*) "TIME_NMLIST: YYYY0 MM0 DD0 set to : ", YYYY0, MM0, DD0 + + write(LOGNAM,*) "CMF::TIME_NMLIST: end: " + + END SUBROUTINE CMF_TIME_NMLIST + !#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_TIME_INIT + ! initialize time-related valiable + ! -- Called from CMF_DRV_INIT + !================================================ + USE YOS_CMF_INPUT, only: DT + USE YOS_CMF_TIME, only: KSTEP, NSTEPS, KMIN, KMINNEXT, KMINSTART, KMINEND + USE YOS_CMF_TIME, only: ISYYYYMMDD,ISHHMM,ISYYYY,ISMM,ISDD,ISHOUR,ISMIN !! start date:hour + USE YOS_CMF_TIME, only: IEYYYYMMDD,IEHHMM,IEYYYY,IEMM,IEDD,IEHOUR,IEMIN !! start date:hour + USE YOS_CMF_TIME, only: IYYYYMMDD, IHHMM, IYYYY, IMM, IDD, IHOUR, IMIN !! date:hour at start of time step + USE YOS_CMF_TIME, only: JYYYYMMDD, JHHMM, JYYYY, JMM, JDD, JHOUR, JMIN !! date:hour at end of time step + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + write(LOGNAM,*) "CMF::TIME_INIT: initialize time variables" + + !*** 1. Start time & End Time + ISYYYYMMDD=SYEAR*10000+SMON*100+SDAY + ISHHMM=SHOUR*100_JPIM + ISYYYY=SYEAR + ISMM =SMON + ISDD =SDAY + ISHOUR=SHOUR + ISMIN =0_JPIM + + IEYYYYMMDD=EYEAR*10000+EMON*100+EDAY !! End time + IEHHMM=EHOUR*100_JPIM + IEYYYY=EYEAR + IEMM =EMON + IEDD =EDAY + IEHOUR=EHOUR + IEMIN =0_JPIM + + write(LOGNAM,*) 'Start Date:',ISYYYYMMDD, ISHHMM, KMINSTART + write(LOGNAM,*) 'End Date:',IEYYYYMMDD, IEHHMM, KMINEND + + !*** 2. Initialize KMIN for START & END Time + KMINSTART=DATE2MIN(ISYYYYMMDD,ISHHMM) + KMINEND =DATE2MIN(IEYYYYMMDD,IEHHMM) + + KMIN=KMINSTART + + !*** 3. Calculate NSTEPS: time steps within simulation time + KSTEP=0 + NSTEPS=int ( ( (KMINEND-KMINSTART)*60_JPIM ) / DT ) !! (End - Start) / DT + + write(LOGNAM,*) 'NSTEPS :',NSTEPS + + !*** 4. Initial time step setting + IYYYYMMDD=ISYYYYMMDD + CALL SPLITDATE(IYYYYMMDD,IYYYY,IMM,IDD) + IHHMM=ISHHMM + CALL SPLITHOUR(IHHMM,IHOUR,IMIN) + + ! tentatively set KMINNEXT to KMIN (just within initialization phase) + KMINNEXT =KMIN + JYYYYMMDD=IYYYYMMDD + JHHMM=IHHMM + CALL SPLITDATE(JYYYYMMDD,JYYYY,JMM,JDD) + CALL SPLITHOUR(JHHMM,JHOUR,JMIN) + + write(LOGNAM,*) 'Initial Time Step Date:Hour :', IYYYYMMDD,'_',IHOUR,':',IMIN + + !*** end + write(LOGNAM,*) "CMF::TIME_INIT: end" + + END SUBROUTINE CMF_TIME_INIT + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_TIME_NEXT + ! update time-related valiable + ! -- Called from CMF_DRV_ADVANCE + !================================================ + USE YOS_CMF_INPUT, only: DT + USE YOS_CMF_TIME, only: KSTEP, KMIN, KMINNEXT + USE YOS_CMF_TIME, only: IYYYYMMDD, IHHMM !! date:hour at start of time step + USE YOS_CMF_TIME, only: JYYYYMMDD, JYYYY, JMM, JDD, JHHMM, JHOUR, JMIN !! date:hour at end of time step + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + !*** 1. Advance KMIN, KSTEP + KSTEP=KSTEP+1 + KMINNEXT=KMIN+INT(DT/60,JPIM) + + write(LOGNAM,*) "CMF::TIME_NEXT: ", KSTEP, KMIN, KMINNEXT, DT + + !*** 2. Update J-time + CALL MIN2DATE(KMINNEXT,JYYYYMMDD,JHHMM) + CALL SPLITDATE(JYYYYMMDD,JYYYY,JMM,JDD) + CALL SPLITHOUR(JHHMM,JHOUR,JMIN) + + write(LOGNAM,*) "Strt of Tstep: KMIN, IYYYYMMDD, IHHMM", KMIN, IYYYYMMDD, IHHMM + write(LOGNAM,*) "End of Tstep: KMINNEXT, JYYYYMMDD, JHHMM", KMINNEXT, JYYYYMMDD, JHHMM + + + END SUBROUTINE CMF_TIME_NEXT + !#################################################################### + + + !#################################################################### + SUBROUTINE CMF_TIME_UPDATE + ! update time-related valiable + ! -- Called from CMF_DRV_ADVANCE + !================================================ + USE YOS_CMF_TIME, only: KMIN, KMINNEXT + USE YOS_CMF_TIME, only: IYYYYMMDD, IYYYY, IMM, IDD, IHHMM, IHOUR, IMIN !! date:hour at start of time step + USE YOS_CMF_TIME, only: JYYYYMMDD, JYYYY, JMM, JDD, JHHMM, JHOUR, JMIN !! date:hour at end of time step + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "CMF_TIME_UPDATE:" + !*** 1. Advance KMIN, KSTEP + KMIN=KMINNEXT + + !*** 2. Update I-time + IYYYYMMDD=JYYYYMMDD + IYYYY=JYYYY + IMM =JMM + IDD =JDD + IHHMM=JHHMM + IHOUR=JHOUR + IMIN =JMIN + + write(LOGNAM,*) "Current time update: KMIN, IYYYYMMDD, IHHMM", KMIN, IYYYYMMDD, IHHMM + + END SUBROUTINE CMF_TIME_UPDATE + !#################################################################### END MODULE CMF_CTRL_TIME_MOD diff --git a/CaMa/src/cmf_ctrl_vars_mod.F90 b/CaMa/src/cmf_ctrl_vars_mod.F90 index a1b1ef89..4a322704 100755 --- a/CaMa/src/cmf_ctrl_vars_mod.F90 +++ b/CaMa/src/cmf_ctrl_vars_mod.F90 @@ -18,309 +18,307 @@ MODULE CMF_CTRL_VARS_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: LOGNAM, LPTHOUT, LDAMOUT, LLEVEE, LWEVAP, LWINFILT, LOUTINS, LGDWDLY -IMPLICIT NONE + USE PARKIND1, only: JPIM, JPRM, JPRB, JPRD + USE YOS_CMF_INPUT, only: LOGNAM, LPTHOUT, LDAMOUT, LLEVEE, LWEVAP, LWINFILT, LOUTINS, LGDWDLY + IMPLICIT NONE CONTAINS -!#################################################################### -! -- CMF_PROG_INIT : Initialize Prognostic variables (include restart data handling) -! -- CMF_DIAG_INIT : Initialize Diagnostic variables -! -!#################################################################### -SUBROUTINE CMF_PROG_INIT -USE YOS_CMF_MAP, ONLY: NSEQMAX, NPTHOUT, NPTHLEV -USE YOS_CMF_PROG, ONLY: D2RUNOFF, D2ROFSUB, & - & P2RIVSTO, P2FLDSTO, D2RIVOUT, D2FLDOUT, & - & D2RIVOUT_PRE, D2FLDOUT_PRE, D2RIVDPH_PRE, D2FLDSTO_PRE, & - & D1PTHFLW, D1PTHFLW_PRE, P2GDWSTO, D2GDWRTN, & - & P2DAMSTO, P2DAMINF, P2LEVSTO , D2WEVAP, D2WINFILT, & !! optional - & D2DAMMY, D2COPY -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -WRITE(LOGNAM,*) "CMF::PROG_INIT: prognostic variable initialization" - -!*** 1. ALLOCATE -! runoff input -ALLOCATE( D2RUNOFF(NSEQMAX,1) ) -ALLOCATE( D2ROFSUB(NSEQMAX,1) ) - -! river+floodplain storage -ALLOCATE( P2RIVSTO(NSEQMAX,1) ) -ALLOCATE( P2FLDSTO(NSEQMAX,1) ) - -! discharge calculation -ALLOCATE( D2RIVOUT(NSEQMAX,1) ) -ALLOCATE( D2FLDOUT(NSEQMAX,1) ) -ALLOCATE( D2RIVOUT_PRE(NSEQMAX,1) ) -ALLOCATE( D2FLDOUT_PRE(NSEQMAX,1) ) -ALLOCATE( D2RIVDPH_PRE(NSEQMAX,1) ) -ALLOCATE( D2FLDSTO_PRE(NSEQMAX,1) ) - -D2RUNOFF(:,:)=0._JPRB -D2ROFSUB(:,:)=0._JPRB - -P2RIVSTO(:,:)=0._JPRD -P2FLDSTO(:,:)=0._JPRD - -D2RIVOUT(:,:)=0._JPRB -D2FLDOUT(:,:)=0._JPRB -D2RIVOUT_PRE(:,:)=0._JPRB -D2FLDOUT_PRE(:,:)=0._JPRB -D2RIVDPH_PRE(:,:)=0._JPRB -D2FLDSTO_PRE(:,:)=0._JPRB - -IF( LPTHOUT ) THEN !! additional prognostics for bifurcation scheme - ALLOCATE( D1PTHFLW(NPTHOUT,NPTHLEV) ) - ALLOCATE( D1PTHFLW_PRE(NPTHOUT,NPTHLEV) ) - D1PTHFLW(:,:)=0._JPRB - D1PTHFLW_PRE(:,:)=0._JPRB -ENDIF -IF( LDAMOUT ) THEN !! additional prognostics for reservoir operation - ALLOCATE( P2DAMSTO(NSEQMAX,1) ) - ALLOCATE( P2DAMINF(NSEQMAX,1) ) - P2DAMSTO(:,:)=0._JPRD - P2DAMINF(:,:)=0._JPRD -ENDIF -IF( LLEVEE ) THEN !! additional prognostics for LLEVEE - ALLOCATE( P2LEVSTO(NSEQMAX,1) ) - P2LEVSTO(:,:)=0._JPRD -ENDIF - -IF( LWEVAP ) THEN !! additional prognostics for LWEVAP - ALLOCATE( D2WEVAP(NSEQMAX,1) ) - D2WEVAP(:,:)=0._JPRB -ENDIF - -!! Used in CoLM -IF( LWINFILT ) THEN !! additional prognostics for LWINFILT - ALLOCATE( D2WINFILT(NSEQMAX,1) ) - D2WEVAP(:,:)=0._JPRB -ENDIF - -!! keep these variables even when LGDWDLY is not used. -ALLOCATE( P2GDWSTO(NSEQMAX,1) ) -ALLOCATE( D2GDWRTN(NSEQMAX,1) ) -P2GDWSTO(:,:)=0._JPRD -D2GDWRTN(:,:)=0._JPRB - -!! dammy variable for data handling -ALLOCATE( D2DAMMY(NSEQMAX,1)) !! Float64/32 switch (Dammy for unused var) -ALLOCATE( D2COPY(NSEQMAX,1)) !! Float64/32 switch (Dammy for output) -D2DAMMY(:,:)=0._JPRB -D2COPY(:,:) =0._JPRB - -!============================ -!*** 2. set initial water surface elevation to sea surface level -WRITE(LOGNAM,*) 'PROG_INIT: fill channels below downstream boundary' -CALL STORAGE_SEA_SURFACE - - -WRITE(LOGNAM,*) "CMF::PROG_INIT: end" - -CONTAINS -!========================================================== -!+ STORAGE_SEA_SURFACE: set initial storage, assuming water surface not lower than downstream sea surface elevation -!+ -!+ -! ================================================== -SUBROUTINE STORAGE_SEA_SURFACE -! set initial storage, assuming water surface not lower than downstream sea surface elevation -USE YOS_CMF_MAP, ONLY: NSEQRIV, NSEQALL, I1NEXT -USE YOS_CMF_MAP, ONLY: D2DWNELV, D2RIVELV,D2RIVHGT,D2RIVWTH,D2RIVLEN -IMPLICIT NONE -! local variables -INTEGER(KIND=JPIM) :: ISEQ, JSEQ -! -REAL(KIND=JPRB),SAVE :: DSEAELV, DDPH + !#################################################################### + ! -- CMF_PROG_INIT : Initialize Prognostic variables (include restart data handling) + ! -- CMF_DIAG_INIT : Initialize Diagnostic variables + ! + !#################################################################### + SUBROUTINE CMF_PROG_INIT + USE YOS_CMF_MAP, only: NSEQMAX, NPTHOUT, NPTHLEV + USE YOS_CMF_PROG, only: D2RUNOFF, D2ROFSUB, & + & P2RIVSTO, P2FLDSTO, D2RIVOUT, D2FLDOUT, & + & D2RIVOUT_PRE, D2FLDOUT_PRE, D2RIVDPH_PRE, D2FLDSTO_PRE, & + & D1PTHFLW, D1PTHFLW_PRE, P2GDWSTO, D2GDWRTN, & + & P2DAMSTO, P2DAMINF, P2LEVSTO , D2WEVAP, D2WINFILT, & !! optional + & D2DAMMY, D2COPY + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + write(LOGNAM,*) "CMF::PROG_INIT: prognostic variable initialization" + + !*** 1. allocate + ! runoff input + allocate( D2RUNOFF(NSEQMAX,1) ) + allocate( D2ROFSUB(NSEQMAX,1) ) + + ! river+floodplain storage + allocate( P2RIVSTO(NSEQMAX,1) ) + allocate( P2FLDSTO(NSEQMAX,1) ) + + ! discharge calculation + allocate( D2RIVOUT(NSEQMAX,1) ) + allocate( D2FLDOUT(NSEQMAX,1) ) + allocate( D2RIVOUT_PRE(NSEQMAX,1) ) + allocate( D2FLDOUT_PRE(NSEQMAX,1) ) + allocate( D2RIVDPH_PRE(NSEQMAX,1) ) + allocate( D2FLDSTO_PRE(NSEQMAX,1) ) + + D2RUNOFF(:,:)=0._JPRB + D2ROFSUB(:,:)=0._JPRB + + P2RIVSTO(:,:)=0._JPRD + P2FLDSTO(:,:)=0._JPRD + + D2RIVOUT(:,:)=0._JPRB + D2FLDOUT(:,:)=0._JPRB + D2RIVOUT_PRE(:,:)=0._JPRB + D2FLDOUT_PRE(:,:)=0._JPRB + D2RIVDPH_PRE(:,:)=0._JPRB + D2FLDSTO_PRE(:,:)=0._JPRB + + IF( LPTHOUT ) THEN !! additional prognostics for bifurcation scheme + allocate( D1PTHFLW(NPTHOUT,NPTHLEV) ) + allocate( D1PTHFLW_PRE(NPTHOUT,NPTHLEV) ) + D1PTHFLW(:,:)=0._JPRB + D1PTHFLW_PRE(:,:)=0._JPRB + ENDIF + IF( LDAMOUT ) THEN !! additional prognostics for reservoir operation + allocate( P2DAMSTO(NSEQMAX,1) ) + allocate( P2DAMINF(NSEQMAX,1) ) + P2DAMSTO(:,:)=0._JPRD + P2DAMINF(:,:)=0._JPRD + ENDIF + IF( LLEVEE ) THEN !! additional prognostics for LLEVEE + allocate( P2LEVSTO(NSEQMAX,1) ) + P2LEVSTO(:,:)=0._JPRD + ENDIF + + IF( LWEVAP ) THEN !! additional prognostics for LWEVAP + allocate( D2WEVAP(NSEQMAX,1) ) + D2WEVAP(:,:)=0._JPRB + ENDIF + + !! Used in CoLM + IF( LWINFILT ) THEN !! additional prognostics for LWINFILT + allocate( D2WINFILT(NSEQMAX,1) ) + D2WEVAP(:,:)=0._JPRB + ENDIF + + !! keep these variables even when LGDWDLY is not used. + allocate( P2GDWSTO(NSEQMAX,1) ) + allocate( D2GDWRTN(NSEQMAX,1) ) + P2GDWSTO(:,:)=0._JPRD + D2GDWRTN(:,:)=0._JPRB + + !! dammy variable for data handling + allocate( D2DAMMY(NSEQMAX,1)) !! Float64/32 switch (Dammy for unused var) + allocate( D2COPY(NSEQMAX,1)) !! Float64/32 switch (Dammy for output) + D2DAMMY(:,:)=0._JPRB + D2COPY(:,:) =0._JPRB + + !============================ + !*** 2. set initial water surface elevation to sea surface level + write(LOGNAM,*) 'PROG_INIT: fill channels below downstream boundary' + CALL STORAGE_SEA_SURFACE + + write(LOGNAM,*) "CMF::PROG_INIT: end" + + CONTAINS + !========================================================== + !+ STORAGE_SEA_SURFACE: set initial storage, assuming water surface not lower than downstream sea surface elevation + !+ + !+ + ! ================================================== + SUBROUTINE STORAGE_SEA_SURFACE + ! set initial storage, assuming water surface not lower than downstream sea surface elevation + USE YOS_CMF_MAP, only: NSEQRIV, NSEQALL, I1NEXT + USE YOS_CMF_MAP, only: D2DWNELV, D2RIVELV,D2RIVHGT,D2RIVWTH,D2RIVLEN + IMPLICIT NONE + ! local variables + integer(KIND=JPIM) :: ISEQ, JSEQ + ! + real(KIND=JPRB),SAVE :: DSEAELV, DDPH !$OMP THREADPRIVATE (DSEAELV, DDPH) -!!================= -! For River Mouth Grid + !!================= + ! For River Mouth Grid !$OMP PARALLEL DO -DO ISEQ=NSEQRIV+1,NSEQALL - DSEAELV=D2DWNELV(ISEQ,1) !! downstream boundary elevation - - !! set initial water level to sea level if river bed is lower than sea level - DDPH=MAX( DSEAELV-D2RIVELV(ISEQ,1),0._JPRB ) - DDPH=MIN( DDPH,D2RIVHGT(ISEQ,1) ) - P2RIVSTO(ISEQ,1)=DDPH*D2RIVLEN(ISEQ,1)*D2RIVWTH(ISEQ,1) - D2RIVDPH_PRE(ISEQ,1)=DDPH -END DO + DO ISEQ=NSEQRIV+1,NSEQALL + DSEAELV=D2DWNELV(ISEQ,1) !! downstream boundary elevation + + !! set initial water level to sea level if river bed is lower than sea level + DDPH=MAX( DSEAELV-D2RIVELV(ISEQ,1),0._JPRB ) + DDPH=MIN( DDPH,D2RIVHGT(ISEQ,1) ) + P2RIVSTO(ISEQ,1)=DDPH*D2RIVLEN(ISEQ,1)*D2RIVWTH(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1)=DDPH + ENDDO !$OMP END PARALLEL DO -!! For Usual River Grid (from downstream to upstream). OMP cannot be applied -DO ISEQ=NSEQRIV,1, -1 - JSEQ=I1NEXT(ISEQ) - DSEAELV=D2RIVELV(JSEQ,1)+D2RIVDPH_PRE(JSEQ,1) - - !! set initial water level to sea level if river bed is lower than sea level - DDPH=MAX( DSEAELV-D2RIVELV(ISEQ,1),0._JPRB ) - DDPH=MIN( DDPH,D2RIVHGT(ISEQ,1) ) - - P2RIVSTO(ISEQ,1)=DDPH*D2RIVLEN(ISEQ,1)*D2RIVWTH(ISEQ,1) - D2RIVDPH_PRE(ISEQ,1)=DDPH -END DO - - -! old version before v4.02 (too slow) -!DO ISEQ=1, NSEQALL -! JSEQ=ISEQ -! DO WHILE( I1NEXT(JSEQ)>0 ) -! KSEQ=JSEQ -! JSEQ=I1NEXT(KSEQ) -! END DO -! -! DSEAELV=D2DWNELV(JSEQ,1) !! downstream boundary elevation -! !! set initial water level to sea level if river bed is lower than sea level -! DDPH=MAX( DSEAELV-D2RIVELV(ISEQ,1),0._JPRB ) -! DDPH=MIN( DDPH,D2RIVHGT(ISEQ,1) ) -! P2RIVSTO(ISEQ,1)=DDPH*D2RIVLEN(ISEQ,1)*D2RIVWTH(ISEQ,1) -!END DO - -END SUBROUTINE STORAGE_SEA_SURFACE -! ================================================== - -END SUBROUTINE CMF_PROG_INIT -!#################################################################### - - - - - - -!#################################################################### -SUBROUTINE CMF_DIAG_INIT - -USE YOS_CMF_MAP, ONLY: NSEQMAX,NPTHOUT,NPTHLEV -USE YOS_CMF_PROG, ONLY: D2DAMMY -USE YOS_CMF_DIAG, ONLY: N2DIAG, D2DIAG, & - & D2RIVINF, D2RIVDPH, D2RIVVEL, D2FLDINF, D2FLDDPH, D2FLDFRC, D2FLDARE, & - & D2PTHOUT, D2PTHINF, D2SFCELV, D2OUTFLW, D2STORGE, D2OUTINS, D2LEVDPH, & - & D2WEVAPEX,D2WINFILTEX -USE YOS_CMF_DIAG, ONLY: N2DIAG_AVG, D2DIAG_AVG, NADD, & - & D2RIVOUT_AVG, D2FLDOUT_AVG, D2OUTFLW_AVG, D2RIVVEL_AVG, D2PTHOUT_AVG, & - & D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, D1PTHFLW_AVG, D2WEVAPEX_AVG,& - D2WINFILTEX_AVG, & - & D2DAMINF_AVG -USE YOS_CMF_DIAG, ONLY: N2DIAG_MAX, D2DIAG_MAX, & - & D2STORGE_MAX, D2OUTFLW_MAX, D2RIVDPH_MAX -IMPLICIT NONE -!*** LOCAL -INTEGER(KIND=JPIM),SAVE :: IND -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!---------------------!" - -WRITE(LOGNAM,*) "CMF::DIAG_INIT: initialize diagnostic variables" - -!*** 1. snapshot 2D diagnostics -N2DIAG=12 -IF ( LLEVEE ) N2DIAG=N2DIAG+1 !! levee variables are added (P2LEVSTO ) -! add water re-infiltration calculation -IF ( LWEVAP ) N2DIAG=N2DIAG+1 !! evapolation added (D2WEVAPEX) -IF ( LWINFILT ) N2DIAG=N2DIAG+1 !! Infiltration added (D2WEVAPEX) -IF ( LOUTINS ) N2DIAG=N2DIAG+1 !! instantaneous discharge added (D2OUTINS ) - -ALLOCATE(D2DIAG(NSEQMAX,1,N2DIAG)) -D2DIAG(:,:,:) = 0._JPRB -D2RIVINF => D2DIAG(:,:,1) -D2RIVDPH => D2DIAG(:,:,2) -D2RIVVEL => D2DIAG(:,:,3) -D2FLDINF => D2DIAG(:,:,4) -D2FLDDPH => D2DIAG(:,:,5) -D2FLDFRC => D2DIAG(:,:,6) -D2FLDARE => D2DIAG(:,:,7) -D2PTHOUT => D2DIAG(:,:,8) -D2PTHINF => D2DIAG(:,:,9) -D2SFCELV => D2DIAG(:,:,10) -D2OUTFLW => D2DIAG(:,:,11) -D2STORGE => D2DIAG(:,:,12) - -IND=12 -IF ( LLEVEE )THEN - IND=IND+1 - D2LEVDPH => D2DIAG(:,:,IND) -ELSE - D2LEVDPH => D2DAMMY(:,:) -ENDIF -IF ( LWEVAP )THEN - IND=IND+1 - D2WEVAPEX => D2DIAG(:,:,IND) -ELSE - D2WEVAPEX => D2DAMMY(:,:) -ENDIF -IF ( LWINFILT )THEN - IND=IND+1 - D2WINFILTEX => D2DIAG(:,:,IND) -ELSE - D2WINFILTEX => D2DAMMY(:,:) -ENDIF -IF ( LOUTINS )THEN - IND=IND+1 - D2OUTINS => D2DIAG(:,:,IND) -ELSE - D2OUTINS => D2DAMMY(:,:) -ENDIF - -!============================ -!*** 2a. time-average 2D diagnostics -N2DIAG_AVG=8 -IF ( LDAMOUT ) N2DIAG_AVG=N2DIAG_AVG+1 !!! D2DAMINF_AVG is added - -ALLOCATE(D2DIAG_AVG(NSEQMAX,1,N2DIAG_AVG)) -D2DIAG_AVG(:,:,:) = 0._JPRB -D2RIVOUT_AVG => D2DIAG_AVG(:,:,1) -D2FLDOUT_AVG => D2DIAG_AVG(:,:,2) -D2OUTFLW_AVG => D2DIAG_AVG(:,:,3) -D2RIVVEL_AVG => D2DIAG_AVG(:,:,4) -D2PTHOUT_AVG => D2DIAG_AVG(:,:,5) - -D2GDWRTN_AVG => D2DIAG_AVG(:,:,6) -D2RUNOFF_AVG => D2DIAG_AVG(:,:,7) -D2ROFSUB_AVG => D2DIAG_AVG(:,:,8) - -IND=8 -IF ( LDAMOUT ) THEN - IND=IND+1 - D2DAMINF_AVG => D2DIAG_AVG(:,:,IND) -ELSE - D2DAMINF_AVG => D2DAMMY(:,:) -ENDIF -IF ( LWEVAP ) THEN - IND=IND+1 - D2WEVAPEX_AVG => D2DIAG_AVG(:,:,IND) -ELSE - D2WEVAPEX_AVG => D2DAMMY(:,:) -ENDIF - -! add water re-infiltration calculation -IF ( LWINFILT ) THEN - IND=IND+1 - D2WINFILTEX_AVG => D2DIAG_AVG(:,:,IND) -ELSE - D2WINFILTEX_AVG => D2DAMMY(:,:) -ENDIF -NADD=0 - -!*** 2b time-average 1D Diagnostics (bifurcation channel) -ALLOCATE(D1PTHFLW_AVG(NPTHOUT,NPTHLEV)) -D1PTHFLW_AVG(:,:) = 0._JPRB - -!============================ -!*** 3. Maximum 2D Diagnostics -N2DIAG_MAX=3 - -ALLOCATE(D2DIAG_MAX(NSEQMAX,1,N2DIAG_MAX)) -D2DIAG_MAX(:,:,:) = 0._JPRB -D2STORGE_MAX => D2DIAG_MAX(:,:,1) -D2OUTFLW_MAX => D2DIAG_MAX(:,:,2) -D2RIVDPH_MAX => D2DIAG_MAX(:,:,3) - -WRITE(LOGNAM,*) "CMF::DIAG_INIT: end" - -END SUBROUTINE CMF_DIAG_INIT -!#################################################################### - + !! For Usual River Grid (from downstream to upstream). OMP cannot be applied + DO ISEQ=NSEQRIV,1, -1 + JSEQ=I1NEXT(ISEQ) + DSEAELV=D2RIVELV(JSEQ,1)+D2RIVDPH_PRE(JSEQ,1) + + !! set initial water level to sea level if river bed is lower than sea level + DDPH=MAX( DSEAELV-D2RIVELV(ISEQ,1),0._JPRB ) + DDPH=MIN( DDPH,D2RIVHGT(ISEQ,1) ) + + P2RIVSTO(ISEQ,1)=DDPH*D2RIVLEN(ISEQ,1)*D2RIVWTH(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1)=DDPH + ENDDO + + + ! old version before v4.02 (too slow) + !DO ISEQ=1, NSEQALL + ! JSEQ=ISEQ + ! DO WHILE( I1NEXT(JSEQ)>0 ) + ! KSEQ=JSEQ + ! JSEQ=I1NEXT(KSEQ) + ! ENDDO + ! + ! DSEAELV=D2DWNELV(JSEQ,1) !! downstream boundary elevation + ! !! set initial water level to sea level if river bed is lower than sea level + ! DDPH=MAX( DSEAELV-D2RIVELV(ISEQ,1),0._JPRB ) + ! DDPH=MIN( DDPH,D2RIVHGT(ISEQ,1) ) + ! P2RIVSTO(ISEQ,1)=DDPH*D2RIVLEN(ISEQ,1)*D2RIVWTH(ISEQ,1) + !ENDDO + + END SUBROUTINE STORAGE_SEA_SURFACE + ! ================================================== + + END SUBROUTINE CMF_PROG_INIT + !#################################################################### + + + + + + + !#################################################################### + SUBROUTINE CMF_DIAG_INIT + + USE YOS_CMF_MAP, only: NSEQMAX,NPTHOUT,NPTHLEV + USE YOS_CMF_PROG, only: D2DAMMY + USE YOS_CMF_DIAG, only: N2DIAG, D2DIAG, & + & D2RIVINF, D2RIVDPH, D2RIVVEL, D2FLDINF, D2FLDDPH, D2FLDFRC, D2FLDARE, & + & D2PTHOUT, D2PTHINF, D2SFCELV, D2OUTFLW, D2STORGE, D2OUTINS, D2LEVDPH, & + & D2WEVAPEX,D2WINFILTEX + USE YOS_CMF_DIAG, only: N2DIAG_AVG, D2DIAG_AVG, NADD, & + & D2RIVOUT_AVG, D2FLDOUT_AVG, D2OUTFLW_AVG, D2RIVVEL_AVG, D2PTHOUT_AVG, & + & D2GDWRTN_AVG, D2RUNOFF_AVG, D2ROFSUB_AVG, D1PTHFLW_AVG, D2WEVAPEX_AVG,& + D2WINFILTEX_AVG, & + & D2DAMINF_AVG + USE YOS_CMF_DIAG, only: N2DIAG_MAX, D2DIAG_MAX, & + & D2STORGE_MAX, D2OUTFLW_MAX, D2RIVDPH_MAX + IMPLICIT NONE + !*** LOCAL + integer(KIND=JPIM),SAVE :: IND + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + + write(LOGNAM,*) "CMF::DIAG_INIT: initialize diagnostic variables" + + !*** 1. snapshot 2D diagnostics + N2DIAG=12 + IF ( LLEVEE ) N2DIAG=N2DIAG+1 !! levee variables are added (P2LEVSTO ) + ! add water re-infiltration calculation + IF ( LWEVAP ) N2DIAG=N2DIAG+1 !! evapolation added (D2WEVAPEX) + IF ( LWINFILT ) N2DIAG=N2DIAG+1 !! Infiltration added (D2WEVAPEX) + IF ( LOUTINS ) N2DIAG=N2DIAG+1 !! instantaneous discharge added (D2OUTINS ) + + allocate(D2DIAG(NSEQMAX,1,N2DIAG)) + D2DIAG(:,:,:) = 0._JPRB + D2RIVINF => D2DIAG(:,:,1) + D2RIVDPH => D2DIAG(:,:,2) + D2RIVVEL => D2DIAG(:,:,3) + D2FLDINF => D2DIAG(:,:,4) + D2FLDDPH => D2DIAG(:,:,5) + D2FLDFRC => D2DIAG(:,:,6) + D2FLDARE => D2DIAG(:,:,7) + D2PTHOUT => D2DIAG(:,:,8) + D2PTHINF => D2DIAG(:,:,9) + D2SFCELV => D2DIAG(:,:,10) + D2OUTFLW => D2DIAG(:,:,11) + D2STORGE => D2DIAG(:,:,12) + + IND=12 + IF ( LLEVEE )THEN + IND=IND+1 + D2LEVDPH => D2DIAG(:,:,IND) + ELSE + D2LEVDPH => D2DAMMY(:,:) + ENDIF + IF ( LWEVAP )THEN + IND=IND+1 + D2WEVAPEX => D2DIAG(:,:,IND) + ELSE + D2WEVAPEX => D2DAMMY(:,:) + ENDIF + IF ( LWINFILT )THEN + IND=IND+1 + D2WINFILTEX => D2DIAG(:,:,IND) + ELSE + D2WINFILTEX => D2DAMMY(:,:) + ENDIF + IF ( LOUTINS )THEN + IND=IND+1 + D2OUTINS => D2DIAG(:,:,IND) + ELSE + D2OUTINS => D2DAMMY(:,:) + ENDIF + + !============================ + !*** 2a. time-average 2D diagnostics + N2DIAG_AVG=8 + IF ( LDAMOUT ) N2DIAG_AVG=N2DIAG_AVG+1 !!! D2DAMINF_AVG is added + + allocate(D2DIAG_AVG(NSEQMAX,1,N2DIAG_AVG)) + D2DIAG_AVG(:,:,:) = 0._JPRB + D2RIVOUT_AVG => D2DIAG_AVG(:,:,1) + D2FLDOUT_AVG => D2DIAG_AVG(:,:,2) + D2OUTFLW_AVG => D2DIAG_AVG(:,:,3) + D2RIVVEL_AVG => D2DIAG_AVG(:,:,4) + D2PTHOUT_AVG => D2DIAG_AVG(:,:,5) + + D2GDWRTN_AVG => D2DIAG_AVG(:,:,6) + D2RUNOFF_AVG => D2DIAG_AVG(:,:,7) + D2ROFSUB_AVG => D2DIAG_AVG(:,:,8) + + IND=8 + IF ( LDAMOUT ) THEN + IND=IND+1 + D2DAMINF_AVG => D2DIAG_AVG(:,:,IND) + ELSE + D2DAMINF_AVG => D2DAMMY(:,:) + ENDIF + IF ( LWEVAP ) THEN + IND=IND+1 + D2WEVAPEX_AVG => D2DIAG_AVG(:,:,IND) + ELSE + D2WEVAPEX_AVG => D2DAMMY(:,:) + ENDIF + + ! add water re-infiltration calculation + IF ( LWINFILT ) THEN + IND=IND+1 + D2WINFILTEX_AVG => D2DIAG_AVG(:,:,IND) + ELSE + D2WINFILTEX_AVG => D2DAMMY(:,:) + ENDIF + NADD=0 + + !*** 2b time-average 1D Diagnostics (bifurcation channel) + allocate(D1PTHFLW_AVG(NPTHOUT,NPTHLEV)) + D1PTHFLW_AVG(:,:) = 0._JPRB + + !============================ + !*** 3. Maximum 2D Diagnostics + N2DIAG_MAX=3 + + allocate(D2DIAG_MAX(NSEQMAX,1,N2DIAG_MAX)) + D2DIAG_MAX(:,:,:) = 0._JPRB + D2STORGE_MAX => D2DIAG_MAX(:,:,1) + D2OUTFLW_MAX => D2DIAG_MAX(:,:,2) + D2RIVDPH_MAX => D2DIAG_MAX(:,:,3) + + write(LOGNAM,*) "CMF::DIAG_INIT: end" + + END SUBROUTINE CMF_DIAG_INIT + !#################################################################### END MODULE CMF_CTRL_VARS_MOD diff --git a/CaMa/src/cmf_drv_advance_mod.F90 b/CaMa/src/cmf_drv_advance_mod.F90 index cba88406..d9bd0b05 100755 --- a/CaMa/src/cmf_drv_advance_mod.F90 +++ b/CaMa/src/cmf_drv_advance_mod.F90 @@ -20,128 +20,128 @@ MODULE CMF_DRV_ADVANCE_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRM, JPRB -USE YOS_CMF_INPUT, ONLY: LOGNAM -IMPLICIT NONE + USE PARKIND1, ONLY: JPIM, JPRM, JPRB + USE YOS_CMF_INPUT, ONLY: LOGNAM + IMPLICIT NONE CONTAINS !#################################################################### ! -- CMF_DRV_ADVANCE : Advance integration for KSPETS ! ! !#################################################################### -SUBROUTINE CMF_DRV_ADVANCE(KSTEPS) -USE YOS_CMF_INPUT, ONLY: LSEALEV -USE YOS_CMF_TIME, ONLY: KSTEP, JYYYYMMDD, JHHMM -! -USE CMF_CTRL_TIME_MOD, ONLY: CMF_TIME_NEXT, CMF_TIME_UPDATE -USE CMF_CTRL_PHYSICS_MOD, ONLY: CMF_PHYSICS_ADVANCE, CMF_PHYSICS_FLDSTG -USE CMF_CTRL_RESTART_MOD, ONLY: CMF_RESTART_WRITE -USE CMF_CTRL_OUTPUT_MOD, ONLY: CMF_OUTPUT_WRITE, CMF_OUTTXT_WRTE -USE CMF_CTRL_DAMOUT_MOD, ONLY: CMF_DAMOUT_WRTE - -USE CMF_CALC_DIAG_MOD, ONLY: CMF_DIAG_AVERAGE, CMF_DIAG_RESET -USE CMF_CTRL_BOUNDARY_MOD, ONLY: CMF_BOUNDARY_UPDATE + SUBROUTINE CMF_DRV_ADVANCE(KSTEPS) + USE YOS_CMF_INPUT, ONLY: LSEALEV + USE YOS_CMF_TIME, ONLY: KSTEP, JYYYYMMDD, JHHMM + ! + USE CMF_CTRL_TIME_MOD, ONLY: CMF_TIME_NEXT, CMF_TIME_UPDATE + USE CMF_CTRL_PHYSICS_MOD, ONLY: CMF_PHYSICS_ADVANCE, CMF_PHYSICS_FLDSTG + USE CMF_CTRL_RESTART_MOD, ONLY: CMF_RESTART_WRITE + USE CMF_CTRL_OUTPUT_MOD, ONLY: CMF_OUTPUT_WRITE, CMF_OUTTXT_WRTE + USE CMF_CTRL_DAMOUT_MOD, ONLY: CMF_DAMOUT_WRTE + + USE CMF_CALC_DIAG_MOD, ONLY: CMF_DIAG_AVERAGE, CMF_DIAG_RESET + USE CMF_CTRL_BOUNDARY_MOD, ONLY: CMF_BOUNDARY_UPDATE #ifdef sediment -USE YOS_CMF_INPUT, ONLY: LSEDOUT -USE yos_cmf_sed, ONLY: step_sed -USE cmf_ctrl_sedout_mod, ONLY: cmf_sed_output -USE cmf_calc_sedflw_mod, ONLY: cmf_calc_sedflw + USE YOS_CMF_INPUT, ONLY: LSEDOUT + USE yos_cmf_sed, ONLY: step_sed + USE cmf_ctrl_sedout_mod, ONLY: cmf_sed_output + USE cmf_calc_sedflw_mod, ONLY: cmf_calc_sedflw #endif -!$ USE OMP_LIB -IMPLICIT NONE -SAVE -! Input argument -INTEGER(KIND=JPIM) :: KSTEPS !! Number of timesteps to advance -!* Local variables -INTEGER(KIND=JPIM) :: ISTEP !! Time Step -REAL(KIND=JPRB) :: ZTT0, ZTT1, ZTT2 !! Time elapsed related -!$ INTEGER(KIND=JPIM) :: NTHREADS !! OpenMP thread number -!========================================================== + !$ USE OMP_LIB + IMPLICIT NONE + SAVE + ! Input argument + INTEGER(KIND=JPIM) :: KSTEPS !! Number of timesteps to advance + !* Local variables + INTEGER(KIND=JPIM) :: ISTEP !! Time Step + REAL(KIND=JPRB) :: ZTT0, ZTT1, ZTT2 !! Time elapsed related + !$ INTEGER(KIND=JPIM) :: NTHREADS !! OpenMP thread number + !========================================================== !*** get OMP thread number !$OMP PARALLEL !$ NTHREADS=OMP_GET_MAX_THREADS() !$OMP END PARALLEL -!================================================ -!*** START: time step loop -DO ISTEP=1,KSTEPS - !============================ - !*** 0. get start CPU time - CALL CPU_TIME(ZTT0) - !$ ZTT0=OMP_GET_WTIME() + !================================================ + !*** START: time step loop + DO ISTEP=1,KSTEPS + !============================ + !*** 0. get start CPU time + CALL CPU_TIME(ZTT0) + !$ ZTT0=OMP_GET_WTIME() - !============================ - !*** 1. Set next time - CALL CMF_TIME_NEXT !! set KMINNEXT, JYYYYMMDD, JHHMM + !============================ + !*** 1. Set next time + CALL CMF_TIME_NEXT !! set KMINNEXT, JYYYYMMDD, JHHMM - !*** (optional) - IF( LSEALEV )THEN - CALL CMF_BOUNDARY_UPDATE - ENDIF + !*** (optional) + IF( LSEALEV )THEN + CALL CMF_BOUNDARY_UPDATE + ENDIF - !============================ - !*** 2. Advance model integration - CALL CMF_PHYSICS_ADVANCE + !============================ + !*** 2. Advance model integration + CALL CMF_PHYSICS_ADVANCE #ifdef sediment - !*** 2b. Advance sediment model integration - IF( LSEDOUT .and. MOD(KSTEP,step_sed)==0 )THEN - CALL cmf_calc_sedflw - ENDIF + !*** 2b. Advance sediment model integration + IF( LSEDOUT .and. MOD(KSTEP,step_sed)==0 )THEN + CALL cmf_calc_sedflw + ENDIF #endif - CALL CPU_TIME(ZTT1) - !$ ZTT1=OMP_GET_WTIME() + CALL CPU_TIME(ZTT1) + !$ ZTT1=OMP_GET_WTIME() - !============================ -! do not write output file in cmf_drv_advance -! the output file will be written in colm driver + !============================ + ! do not write output file in cmf_drv_advance + ! the output file will be written in colm driver - !*** 3. Write output file (when needed) - ! IF( LOUTPUT .and. MOD(JHOUR,IFRQ_OUT)==0 .and. JMIN==0 )then - !*** average variable - ! CALL CMF_DIAG_AVERAGE + !*** 3. Write output file (when needed) + ! IF( LOUTPUT .and. MOD(JHOUR,IFRQ_OUT)==0 .and. JMIN==0 )then + !*** average variable + ! CALL CMF_DIAG_AVERAGE - !*** write output data - ! CALL CMF_OUTPUT_WRITE + !*** write output data + ! CALL CMF_OUTPUT_WRITE #ifdef sediment - IF ( LSEDOUT ) THEN - CALL cmf_sed_output - ENDIF + IF ( LSEDOUT ) THEN + CALL cmf_sed_output + ENDIF #endif - ! --- Optional: text file output - CALL CMF_OUTTXT_WRTE !! reservoir operation - CALL CMF_DAMOUT_WRTE !! reservoir operation - - ! not need to reset variable here, will be reset in colm driver - !*** reset variable - ! CALL CMF_DIAG_RESET - ! ENDIF - - ! not need to write restart file here, will be written in colm driver - !============================ - !*** 4. Write restart file - ! CALL CMF_RESTART_WRITE - - !============================ - !*** 5. Update current time !! Update KMIN, IYYYYMMDD, IHHMM (to KMINNEXT, JYYYYMMDD, JHHMM) - CALL CMF_TIME_UPDATE - - !============================ - !*** 6. Check CPU time - CALL CPU_TIME(ZTT2) - !$ ZTT2=OMP_GET_WTIME() - WRITE(LOGNAM,*) "CMF::DRV_ADVANCE END: KSTEP, time (end of Tstep):", KSTEP, JYYYYMMDD, JHHMM - WRITE(LOGNAM,'(a,f8.1,a,f8.1,a)') "Elapsed cpu time", ZTT2-ZTT0,"Sec. // File output ", ZTT2-ZTT1, "Sec" - -ENDDO -!*** END:time step loop -!================================================ - -END SUBROUTINE CMF_DRV_ADVANCE -!#################################################################### + ! --- Optional: text file output + CALL CMF_OUTTXT_WRTE !! reservoir operation + CALL CMF_DAMOUT_WRTE !! reservoir operation + + ! not need to reset variable here, will be reset in colm driver + !*** reset variable + ! CALL CMF_DIAG_RESET + ! ENDIF + + ! not need to write restart file here, will be written in colm driver + !============================ + !*** 4. Write restart file + ! CALL CMF_RESTART_WRITE + + !============================ + !*** 5. Update current time !! Update KMIN, IYYYYMMDD, IHHMM (to KMINNEXT, JYYYYMMDD, JHHMM) + CALL CMF_TIME_UPDATE + + !============================ + !*** 6. Check CPU time + CALL CPU_TIME(ZTT2) + !$ ZTT2=OMP_GET_WTIME() + WRITE(LOGNAM,*) "CMF::DRV_ADVANCE END: KSTEP, time (end of Tstep):", KSTEP, JYYYYMMDD, JHHMM + WRITE(LOGNAM,'(a,f8.1,a,f8.1,a)') "Elapsed cpu time", ZTT2-ZTT0,"Sec. // File output ", ZTT2-ZTT1, "Sec" + + ENDDO + !*** END:time step loop + !================================================ + + END SUBROUTINE CMF_DRV_ADVANCE + !#################################################################### END MODULE CMF_DRV_ADVANCE_MOD diff --git a/CaMa/src/cmf_drv_control_mod.F90 b/CaMa/src/cmf_drv_control_mod.F90 index 3de10c91..fc3b0fcc 100755 --- a/CaMa/src/cmf_drv_control_mod.F90 +++ b/CaMa/src/cmf_drv_control_mod.F90 @@ -17,293 +17,293 @@ MODULE CMF_DRV_CONTROL_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -!** shared variables in module -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -USE YOS_CMF_INPUT, ONLY: LOGNAM -USE YOS_CMF_MAP, ONLY: REGIONALL, REGIONTHIS -IMPLICIT NONE -!** local variables -SAVE -REAL(KIND=JPRB) :: ZTT0, ZTT1, ZTT2 ! Time elapsed related + !** shared variables in module + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM + USE YOS_CMF_MAP, only: REGIONALL, REGIONTHIS + IMPLICIT NONE + !** local variables + SAVE + real(KIND=JPRB) :: ZTT0, ZTT1, ZTT2 ! Time elapsed related !========================================================== CONTAINS -!#################################################################### -! -- CMF_DRV_INPUT : Set namelist & logfile -! -- CMF_DRV_INIT : Initialize CaMa-Flood -! -- CMF_DRV_END : Finalize CaMa-Flood -! -!#################################################################### -SUBROUTINE CMF_DRV_INPUT -! Read setting from namelist ("input_flood.nam" as default) -! -- Called from CMF_DRV_INIT -USE YOS_CMF_INPUT, ONLY: LLOGOUT, LOGNAM, CLOGOUT, CSETFILE, LSEALEV, LDAMOUT, LLEVEE, LOUTPUT -USE CMF_CTRL_NMLIST_MOD, ONLY: CMF_CONFIG_NMLIST, CMF_CONFIG_CHECK -USE CMF_CTRL_TIME_MOD, ONLY: CMF_TIME_NMLIST -USE CMF_CTRL_FORCING_MOD, ONLY: CMF_FORCING_NMLIST -USE CMF_CTRL_BOUNDARY_MOD, ONLY: CMF_BOUNDARY_NMLIST -USE CMF_CTRL_RESTART_MOD, ONLY: CMF_RESTART_NMLIST -USE CMF_CTRL_DAMOUT_MOD, ONLY: CMF_DAMOUT_NMLIST -USE CMF_CTRL_LEVEE_MOD, ONLY: CMF_LEVEE_NMLIST -USE CMF_CTRL_OUTPUT_MOD, ONLY: CMF_OUTPUT_NMLIST -USE CMF_CTRL_MAPS_MOD, ONLY: CMF_MAPS_NMLIST -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID + !#################################################################### + ! -- CMF_DRV_INPUT : Set namelist & logfile + ! -- CMF_DRV_INIT : Initialize CaMa-Flood + ! -- CMF_DRV_END : Finalize CaMa-Flood + ! + !#################################################################### + SUBROUTINE CMF_DRV_INPUT + ! Read setting from namelist ("input_flood.nam" as default) + ! -- Called from CMF_DRV_INIT + USE YOS_CMF_INPUT, only: LLOGOUT, LOGNAM, CLOGOUT, CSETFILE, LSEALEV, LDAMOUT, LLEVEE, LOUTPUT + USE CMF_CTRL_NMLIST_MOD, only: CMF_CONFIG_NMLIST, CMF_CONFIG_CHECK + USE CMF_CTRL_TIME_MOD, only: CMF_TIME_NMLIST + USE CMF_CTRL_FORCING_MOD, only: CMF_FORCING_NMLIST + USE CMF_CTRL_BOUNDARY_MOD, only: CMF_BOUNDARY_NMLIST + USE CMF_CTRL_RESTART_MOD, only: CMF_RESTART_NMLIST + USE CMF_CTRL_DAMOUT_MOD, only: CMF_DAMOUT_NMLIST + USE CMF_CTRL_LEVEE_MOD, only: CMF_LEVEE_NMLIST + USE CMF_CTRL_OUTPUT_MOD, only: CMF_OUTPUT_NMLIST + USE CMF_CTRL_MAPS_MOD, only: CMF_MAPS_NMLIST + USE CMF_UTILS_MOD, only: INQUIRE_FID #ifdef sediment -USE YOS_CMF_INPUT, ONLY: LSEDOUT -USE cmf_ctrl_sed_mod, ONLY: cmf_sed_nmlist + USE YOS_CMF_INPUT, only: LSEDOUT + USE cmf_ctrl_sed_mod, only: cmf_sed_nmlist #endif -IMPLICIT NONE -!* local -CHARACTER(LEN=8) :: CREG !! -!================================================ + IMPLICIT NONE + !* local + character(LEN=8) :: CREG !! + !================================================ -!*** 0a. Set log file & namelist -! Preset in YOS_INPUT: LLOGOUT=.TRUE. CLOGOUT='./log_CaMa.txt' -! It can be modified in MAIN program before DRV_INPUT + !*** 0a. Set log file & namelist + ! Preset in YOS_INPUT: LLOGOUT=.TRUE. CLOGOUT='./log_CaMa.txt' + ! It can be modified in MAIN program before DRV_INPUT -IF (REGIONALL>=2 )then - WRITE(CREG,'(I0)') REGIONTHIS !! Distributed Log Output for MPI run - CLOGOUT=TRIM(CLOGOUT)//'-'//TRIM(CREG) !! Change suffix of output file for each calculation node -ENDIF + IF (REGIONALL>=2 )THEN + write(CREG,'(I0)') REGIONTHIS !! Distributed Log Output for MPI run + CLOGOUT=TRIM(CLOGOUT)//'-'//TRIM(CREG) !! Change suffix of output file for each calculation node + ENDIF -IF( LLOGOUT )THEN - LOGNAM=INQUIRE_FID() - OPEN(LOGNAM,FILE=CLOGOUT,FORM='FORMATTED') -ELSE - LOGNAM=6 !! use standard output - CLOGOUT="NONE" -ENDIF + IF( LLOGOUT )THEN + LOGNAM=INQUIRE_FID() + open(LOGNAM,FILE=CLOGOUT,FORM='FORMATTED') + ELSE + LOGNAM=6 !! use standard output + CLOGOUT="NONE" + ENDIF -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!******************************" -WRITE(LOGNAM,*) "CMF::DRV_INPUT: log file: ", TRIM(CLOGOUT), LOGNAM + write(LOGNAM,*) "" + write(LOGNAM,*) "!******************************" + write(LOGNAM,*) "CMF::DRV_INPUT: log file: ", TRIM(CLOGOUT), LOGNAM -!*** 0b. Input namelist filename -! Preset in YOS_INPUT: CSETFILE="input_cmf.nam" -! It can be modified in MAIN program before DRV_INPUT -WRITE(LOGNAM,*) "CMF::DRV_INPUT: input namelist: ", TRIM(CSETFILE) + !*** 0b. Input namelist filename + ! Preset in YOS_INPUT: CSETFILE="input_cmf.nam" + ! It can be modified in MAIN program before DRV_INPUT + write(LOGNAM,*) "CMF::DRV_INPUT: input namelist: ", TRIM(CSETFILE) -!*** 1. CaMa-Flood configulation namelist -CALL CMF_CONFIG_NMLIST + !*** 1. CaMa-Flood configulation namelist + CALL CMF_CONFIG_NMLIST -CALL CMF_TIME_NMLIST + CALL CMF_TIME_NMLIST -CALL CMF_MAPS_NMLIST + CALL CMF_MAPS_NMLIST -!*** 2. read namelist for each module -CALL CMF_FORCING_NMLIST + !*** 2. read namelist for each module + CALL CMF_FORCING_NMLIST -IF( LSEALEV )THEN - CALL CMF_BOUNDARY_NMLIST -ENDIF + IF( LSEALEV )THEN + CALL CMF_BOUNDARY_NMLIST + ENDIF -CALL CMF_RESTART_NMLIST + CALL CMF_RESTART_NMLIST -IF( LDAMOUT )THEN - CALL CMF_DAMOUT_NMLIST -ENDIF + IF( LDAMOUT )THEN + CALL CMF_DAMOUT_NMLIST + ENDIF -IF( LLEVEE )THEN - CALL CMF_LEVEE_NMLIST -ENDIF + IF( LLEVEE )THEN + CALL CMF_LEVEE_NMLIST + ENDIF -IF( LOUTPUT )THEN - CALL CMF_OUTPUT_NMLIST -ENDIF + IF( LOUTPUT )THEN + CALL CMF_OUTPUT_NMLIST + ENDIF #ifdef sediment -IF( LSEDOUT )THEN - CALL cmf_sed_nmlist -ENDIF + IF( LSEDOUT )THEN + CALL cmf_sed_nmlist + ENDIF #endif -WRITE(LOGNAM,*) "CMF::DRV_INPUT: end reading namelist" + write(LOGNAM,*) "CMF::DRV_INPUT: end reading namelist" -!*** 3. check configulation conflicts -CALL CMF_CONFIG_CHECK + !*** 3. check configulation conflicts + CALL CMF_CONFIG_CHECK -WRITE(LOGNAM,*) "CMF::DRV_INPUT: finished" -WRITE(LOGNAM,*) "******************************!" -WRITE(LOGNAM,*) "" + write(LOGNAM,*) "CMF::DRV_INPUT: finished" + write(LOGNAM,*) "******************************!" + write(LOGNAM,*) "" -END SUBROUTINE CMF_DRV_INPUT -!#################################################################### + END SUBROUTINE CMF_DRV_INPUT + !#################################################################### -!#################################################################### -SUBROUTINE CMF_DRV_INIT -! Initialize CaMa-Flood -! -- Called from CMF_DRV_INIT -USE YOS_CMF_INPUT, ONLY: LRESTART, LSTOONLY, LOUTPUT, LSEALEV, LDAMOUT, LLEVEE, LOUTINI -! init routines -USE CMF_CTRL_TIME_MOD, ONLY: CMF_TIME_INIT -USE CMF_CTRL_MAPS_MOD, ONLY: CMF_RIVMAP_INIT, CMF_TOPO_INIT -USE CMF_CTRL_VARS_MOD, ONLY: CMF_PROG_INIT, CMF_DIAG_INIT -USE CMF_CTRL_FORCING_MOD, ONLY: CMF_FORCING_INIT -USE CMF_CTRL_BOUNDARY_MOD, ONLY: CMF_BOUNDARY_INIT -USE CMF_CTRL_OUTPUT_MOD, ONLY: CMF_OUTPUT_INIT, CMF_OUTPUT_WRITE -USE CMF_CTRL_RESTART_MOD, ONLY: CMF_RESTART_INIT -USE CMF_CTRL_DAMOUT_MOD, ONLY: CMF_DAMOUT_INIT -USE CMF_CTRL_LEVEE_MOD, ONLY: CMF_LEVEE_INIT + !#################################################################### + SUBROUTINE CMF_DRV_INIT + ! Initialize CaMa-Flood + ! -- Called from CMF_DRV_INIT + USE YOS_CMF_INPUT, only: LRESTART, LSTOONLY, LOUTPUT, LSEALEV, LDAMOUT, LLEVEE, LOUTINI + ! init routines + USE CMF_CTRL_TIME_MOD, only: CMF_TIME_INIT + USE CMF_CTRL_MAPS_MOD, only: CMF_RIVMAP_INIT, CMF_TOPO_INIT + USE CMF_CTRL_VARS_MOD, only: CMF_PROG_INIT, CMF_DIAG_INIT + USE CMF_CTRL_FORCING_MOD, only: CMF_FORCING_INIT + USE CMF_CTRL_BOUNDARY_MOD, only: CMF_BOUNDARY_INIT + USE CMF_CTRL_OUTPUT_MOD, only: CMF_OUTPUT_INIT, CMF_OUTPUT_WRITE + USE CMF_CTRL_RESTART_MOD, only: CMF_RESTART_INIT + USE CMF_CTRL_DAMOUT_MOD, only: CMF_DAMOUT_INIT + USE CMF_CTRL_LEVEE_MOD, only: CMF_LEVEE_INIT #ifdef sediment -USE YOS_CMF_INPUT, ONLY: LSEDOUT -USE cmf_ctrl_sed_mod, ONLY: cmf_sed_init + USE YOS_CMF_INPUT, only: LSEDOUT + USE cmf_ctrl_sed_mod, only: cmf_sed_init #endif -! import -USE CMF_CTRL_PHYSICS_MOD, ONLY: CMF_PHYSICS_FLDSTG -USE CMF_OPT_OUTFLW_MOD, ONLY: CMF_CALC_OUTPRE -USE CMF_UTILS_MOD, ONLY: INQUIRE_FID -!$ USE OMP_LIB -IMPLICIT NONE -!================================================ -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!******************************!" -WRITE(LOGNAM,*) "CMF::DRV_INIT: initialization start" - -!*** 0b. get start time -CALL CPU_TIME(ZTT0) -!$ ZTT0=OMP_GET_WTIME() - -!================================================ -WRITE(LOGNAM,*) "CMF::DRV_INIT: (1) Set Time" - -!*** 1a. Set time related -CALL CMF_TIME_INIT - -!================================================ -WRITE(LOGNAM,*) "CMF::DRV_INIT: (2) Set River Map & Topography" - -!*** 2a. Read input river map -CALL CMF_RIVMAP_INIT - -!*** 2b. Set topography -CALL CMF_TOPO_INIT - -!*** 2c. Optional levee scheme initialization -IF( LLEVEE )THEN - CALL CMF_LEVEE_INIT -ENDIF - -!================================================ -WRITE(LOGNAM,*) "CMF::DRV_INIT: (3) Set output & forcing modules" - -!*** 3a. Create Output files -!IF( LOUTPUT )THEN -CALL CMF_OUTPUT_INIT -!ENDIF - -!*** 3b. Initialize forcing data -CALL CMF_FORCING_INIT - -!*** 3b. Initialize dynamic sea level boundary data -IF( LSEALEV )THEN - CALL CMF_BOUNDARY_INIT -ENDIF -!================================================ -WRITE(LOGNAM,*) "CMF::DRV_INIT: (4) Allocate prog&diag vars & initialize" - -!*** 4a. Set initial prognostic variables -CALL CMF_PROG_INIT - -!*** 4b. Initialize (allocate) diagnostic arrays -CALL CMF_DIAG_INIT - -!v4.03 CALC_FLDSTG for zero storage restart -CALL CMF_PHYSICS_FLDSTG - -!*** 4c. Restart file -IF( LRESTART )THEN - CALL CMF_RESTART_INIT -ENDIF - -!*** 4d. Optional reservoir initialization -IF( LDAMOUT )THEN - CALL CMF_DAMOUT_INIT -ENDIF + ! import + USE CMF_CTRL_PHYSICS_MOD, only: CMF_PHYSICS_FLDSTG + USE CMF_OPT_OUTFLW_MOD, only: CMF_CALC_OUTPRE + USE CMF_UTILS_MOD, only: INQUIRE_FID + !$ USE OMP_LIB + IMPLICIT NONE + !================================================ + write(LOGNAM,*) "" + write(LOGNAM,*) "!******************************!" + write(LOGNAM,*) "CMF::DRV_INIT: initialization start" + + !*** 0b. get start time + CALL CPU_TIME(ZTT0) + !$ ZTT0=OMP_GET_WTIME() + + !================================================ + write(LOGNAM,*) "CMF::DRV_INIT: (1) Set Time" + + !*** 1a. Set time related + CALL CMF_TIME_INIT + + !================================================ + write(LOGNAM,*) "CMF::DRV_INIT: (2) Set River Map & Topography" + + !*** 2a. Read input river map + CALL CMF_RIVMAP_INIT + + !*** 2b. Set topography + CALL CMF_TOPO_INIT + + !*** 2c. Optional levee scheme initialization + IF( LLEVEE )THEN + CALL CMF_LEVEE_INIT + ENDIF + + !================================================ + write(LOGNAM,*) "CMF::DRV_INIT: (3) Set output & forcing modules" + + !*** 3a. Create Output files + !IF( LOUTPUT )THEN + CALL CMF_OUTPUT_INIT + !ENDIF + + !*** 3b. Initialize forcing data + CALL CMF_FORCING_INIT + + !*** 3b. Initialize dynamic sea level boundary data + IF( LSEALEV )THEN + CALL CMF_BOUNDARY_INIT + ENDIF + !================================================ + write(LOGNAM,*) "CMF::DRV_INIT: (4) allocate prog&diag vars & initialize" + + !*** 4a. Set initial prognostic variables + CALL CMF_PROG_INIT + + !*** 4b. Initialize (allocate) diagnostic arrays + CALL CMF_DIAG_INIT + + !v4.03 CALC_FLDSTG for zero storage restart + CALL CMF_PHYSICS_FLDSTG + + !*** 4c. Restart file + IF( LRESTART )THEN + CALL CMF_RESTART_INIT + ENDIF + + !*** 4d. Optional reservoir initialization + IF( LDAMOUT )THEN + CALL CMF_DAMOUT_INIT + ENDIF #ifdef sediment -!*** 4e. Optional sediment initialization -IF( LSEDOUT )THEN - CALL cmf_sed_init -ENDIF + !*** 4e. Optional sediment initialization + IF( LSEDOUT )THEN + CALL cmf_sed_init + ENDIF #endif -!================================================ -!** v4.03 CALC_FLDSTG moved to the top of CTRL_PHYSICS for strict restart configulation (Hatono & Yamazaki) + !================================================ + !** v4.03 CALC_FLDSTG moved to the top of CTRL_PHYSICS for strict restart configulation (Hatono & Yamazaki) -!*** 5 reconstruct previous t-step flow (if needed) -IF( LRESTART .AND. LSTOONLY )THEN - WRITE(LOGNAM,*) "CMF::DRV_INIT: (5a) set flood stage at initial condition" - !** v4.03 CALC_FLDSTG for storagy only restart (v4.03) - CALL CMF_PHYSICS_FLDSTG - CALL CMF_CALC_OUTPRE !! bugfix in v4.12 -ENDIF + !*** 5 reconstruct previous t-step flow (if needed) + IF( LRESTART .and. LSTOONLY )THEN + write(LOGNAM,*) "CMF::DRV_INIT: (5a) set flood stage at initial condition" + !** v4.03 CALC_FLDSTG for storagy only restart (v4.03) + CALL CMF_PHYSICS_FLDSTG + CALL CMF_CALC_OUTPRE !! bugfix in v4.12 + ENDIF -!*** 5b save initial storage if LOUTINI specified -IF ( LOUTINI .AND. LOUTPUT ) THEN - WRITE(LOGNAM,*) "CMF::DRV_INIT: (5b) write initial condition" - CALL CMF_OUTPUT_WRITE -ENDIF + !*** 5b save initial storage if LOUTINI specified + IF ( LOUTINI .and. LOUTPUT ) THEN + write(LOGNAM,*) "CMF::DRV_INIT: (5b) write initial condition" + CALL CMF_OUTPUT_WRITE + ENDIF -!================================================ + !================================================ -!*** get initialization end time time -CALL CPU_TIME(ZTT1) -!$ ZTT1=OMP_GET_WTIME() + !*** get initialization end time time + CALL CPU_TIME(ZTT1) + !$ ZTT1=OMP_GET_WTIME() -WRITE(LOGNAM,*) "CMF::DRV_INIT: initialization finished:" -WRITE(LOGNAM,*) "Elapsed cpu time (Init)", ZTT1-ZTT0,"Seconds" -WRITE(LOGNAM,*) "CMF::DRV_INIT: end" -WRITE(LOGNAM,*) "***********************************" + write(LOGNAM,*) "CMF::DRV_INIT: initialization finished:" + write(LOGNAM,*) "Elapsed cpu time (Init)", ZTT1-ZTT0,"Seconds" + write(LOGNAM,*) "CMF::DRV_INIT: end" + write(LOGNAM,*) "***********************************" -END SUBROUTINE CMF_DRV_INIT -!#################################################################### + END SUBROUTINE CMF_DRV_INIT + !#################################################################### -!#################################################################### -SUBROUTINE CMF_DRV_END -! Finalize CaMa-Flood -USE YOS_CMF_INPUT, ONLY: LOUTPUT, LSEALEV -USE CMF_CTRL_OUTPUT_MOD, ONLY: CMF_OUTPUT_END -USE CMF_CTRL_FORCING_MOD, ONLY: CMF_FORCING_END -USE CMF_CTRL_BOUNDARY_MOD, ONLY: CMF_BOUNDARY_END + !#################################################################### + SUBROUTINE CMF_DRV_END + ! Finalize CaMa-Flood + USE YOS_CMF_INPUT, only: LOUTPUT, LSEALEV + USE CMF_CTRL_OUTPUT_MOD, only: CMF_OUTPUT_END + USE CMF_CTRL_FORCING_MOD, only: CMF_FORCING_END + USE CMF_CTRL_BOUNDARY_MOD, only: CMF_BOUNDARY_END #ifdef sediment -USE YOS_CMF_INPUT, ONLY: LSEDOUT -USE cmf_ctrl_sedout_mod, ONLY: sediment_output_end + USE YOS_CMF_INPUT, only: LSEDOUT + USE cmf_ctrl_sedout_mod, only: sediment_output_end #endif -!$ USE OMP_LIB -IMPLICIT NONE -!========================================================== -WRITE(LOGNAM,*) "" -WRITE(LOGNAM,*) "!******************************!" -WRITE(LOGNAM,*) "CMF::DRV_END: finalize forcing & output modules" -CALL CMF_FORCING_END -IF( LOUTPUT )THEN - CALL CMF_OUTPUT_END + !$ USE OMP_LIB + IMPLICIT NONE + !========================================================== + write(LOGNAM,*) "" + write(LOGNAM,*) "!******************************!" + write(LOGNAM,*) "CMF::DRV_END: finalize forcing & output modules" + CALL CMF_FORCING_END + IF( LOUTPUT )THEN + CALL CMF_OUTPUT_END #ifdef sediment - IF( LSEDOUT ) call sediment_output_end + IF( LSEDOUT ) CALL sediment_output_end #endif -ENDIF -IF( LSEALEV ) THEN - CALL CMF_BOUNDARY_END -ENDIF - -!*** get simulation end time -CALL CPU_TIME(ZTT2) -!$ ZTT2=OMP_GET_WTIME() -WRITE(LOGNAM,*) "CMF::DRV_END: simulation finished in:",ZTT2-ZTT0,' Seconds' - -WRITE(LOGNAM,*) "CMF::DRV_END: close logfile" -WRITE(LOGNAM,*) "CMF::===== CALCULATION END =====" -CLOSE(LOGNAM) - -END SUBROUTINE CMF_DRV_END -!#################################################################### + ENDIF + IF( LSEALEV ) THEN + CALL CMF_BOUNDARY_END + ENDIF + + !*** get simulation end time + CALL CPU_TIME(ZTT2) + !$ ZTT2=OMP_GET_WTIME() + write(LOGNAM,*) "CMF::DRV_END: simulation finished in:",ZTT2-ZTT0,' Seconds' + + write(LOGNAM,*) "CMF::DRV_END: close logfile" + write(LOGNAM,*) "CMF::===== CALCULATION END =====" + close(LOGNAM) + + END SUBROUTINE CMF_DRV_END + !#################################################################### END MODULE CMF_DRV_CONTROL_MOD diff --git a/CaMa/src/cmf_opt_outflw_mod.F90 b/CaMa/src/cmf_opt_outflw_mod.F90 index 08e12381..d3677dbb 100755 --- a/CaMa/src/cmf_opt_outflw_mod.F90 +++ b/CaMa/src/cmf_opt_outflw_mod.F90 @@ -24,427 +24,427 @@ MODULE CMF_OPT_OUTFLW_MOD ! CMF_CALC_OUTPRE: reconstruct previous time-step outflow by diffusion waev, for LSTOONLY restart ! CMF_CALC_OUTINS: calculate instantaneous discharge using river network map !#################################################################### -SUBROUTINE CMF_CALC_OUTFLW_KINE -! Calculate discharge, mix kinematic & local inertial, depending on slope -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: DT, PMANFLD, PMINSLP, LFLDOUT, LSLOPEMOUTH -USE YOS_CMF_MAP, ONLY: I1NEXT, NSEQALL, NSEQRIV -USE YOS_CMF_MAP, ONLY: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH -USE YOS_CMF_MAP, ONLY: D2RIVLEN, D2RIVMAN, D2ELEVSLOPE -USE YOS_CMF_PROG, ONLY: P2RIVSTO, D2RIVOUT, P2FLDSTO, D2FLDOUT -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2RIVVEL, D2FLDDPH, D2SFCELV -IMPLICIT NONE -INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ -REAL(KIND=JPRB),SAVE :: DSLOPE, DAREA , DVEL, DSLOPE_F, DARE_F, DVEL_F + SUBROUTINE CMF_CALC_OUTFLW_KINE + ! Calculate discharge, mix kinematic & local inertial, depending on slope + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: DT, PMANFLD, PMINSLP, LFLDOUT, LSLOPEMOUTH + USE YOS_CMF_MAP, only: I1NEXT, NSEQALL, NSEQRIV + USE YOS_CMF_MAP, only: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH + USE YOS_CMF_MAP, only: D2RIVLEN, D2RIVMAN, D2ELEVSLOPE + USE YOS_CMF_PROG, only: P2RIVSTO, D2RIVOUT, P2FLDSTO, D2FLDOUT + USE YOS_CMF_DIAG, only: D2RIVDPH, D2RIVVEL, D2FLDDPH, D2SFCELV + IMPLICIT NONE + integer(KIND=JPIM),SAVE :: ISEQ, JSEQ + real(KIND=JPRB),SAVE :: DSLOPE, DAREA , DVEL, DSLOPE_F, DARE_F, DVEL_F !$OMP THREADPRIVATE (JSEQ, DSLOPE, DAREA , DVEL, DSLOPE_F, DARE_F, DVEL_F) -!================================================ + !================================================ !*** 0. calculate surface water elevation, reset inflow !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) -END DO + DO ISEQ=1, NSEQALL + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + ENDDO !$OMP END PARALLEL DO !============================ !*** 1a. discharge for usual river grid !$OMP PARALLEL DO -DO ISEQ=1, NSEQRIV - JSEQ = I1NEXT(ISEQ) -! === river flow - DSLOPE = (D2ELEVTN(ISEQ,1)-D2ELEVTN(JSEQ,1)) * D2NXTDST(ISEQ,1)**(-1.) - DSLOPE = max(DSLOPE,PMINSLP) - DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) - DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) - - D2RIVVEL(ISEQ,1) = DVEL - D2RIVOUT(ISEQ,1) = DAREA * DVEL - D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) -!=== floodplain flow - IF( LFLDOUT )THEN - DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set min [instead of using weir equation for efficiency] - DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F - D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) - ENDIF -END DO + DO ISEQ=1, NSEQRIV + JSEQ = I1NEXT(ISEQ) + ! === river flow + DSLOPE = (D2ELEVTN(ISEQ,1)-D2ELEVTN(JSEQ,1)) * D2NXTDST(ISEQ,1)**(-1.) + DSLOPE = max(DSLOPE,PMINSLP) + DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) + DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) + + D2RIVVEL(ISEQ,1) = DVEL + D2RIVOUT(ISEQ,1) = DAREA * DVEL + D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) + !=== floodplain flow + IF( LFLDOUT )THEN + DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set min [instead of using weir equation for efficiency] + DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F + D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) + ENDIF + ENDDO !$OMP END PARALLEL DO !============================ !*** 1b. discharge for river mouth grids !$OMP PARALLEL DO -DO ISEQ=NSEQRIV+1, NSEQALL -!=== Kinematic approach, river mouth flow - IF ( LSLOPEMOUTH ) THEN - ! prescribed slope - DSLOPE = D2ELEVSLOPE(ISEQ,1) - ELSE - DSLOPE = PMINSLP - ENDIF - DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) - DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) - - D2RIVVEL(ISEQ,1) = DVEL - D2RIVOUT(ISEQ,1) = DAREA * DVEL - D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) - -!=== kinematic, floodplain mouth flow - IF( LFLDOUT )THEN - DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set min [instead of using weir equation for efficiency] - DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F - D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) - ENDIF -END DO + DO ISEQ=NSEQRIV+1, NSEQALL + !=== Kinematic approach, river mouth flow + IF ( LSLOPEMOUTH ) THEN + ! prescribed slope + DSLOPE = D2ELEVSLOPE(ISEQ,1) + ELSE + DSLOPE = PMINSLP + ENDIF + DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) + DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) + + D2RIVVEL(ISEQ,1) = DVEL + D2RIVOUT(ISEQ,1) = DAREA * DVEL + D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) + + !=== kinematic, floodplain mouth flow + IF( LFLDOUT )THEN + DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set min [instead of using weir equation for efficiency] + DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F + D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) + ENDIF + ENDDO !$OMP END PARALLEL DO - -END SUBROUTINE CMF_CALC_OUTFLW_KINE -!#################################################################### - - - - - -!#################################################################### -SUBROUTINE CMF_CALC_OUTFLW_KINEMIX -! Calculate discharge, mix kinematic & local inertial, depending on slope -USE PARKIND1, ONLY: JPIM, JPRB, JPRD -USE YOS_CMF_INPUT, ONLY: DT, LFLDOUT -USE YOS_CMF_INPUT, ONLY: PDSTMTH, PMANFLD, PGRV , PMINSLP -USE YOS_CMF_MAP, ONLY: I1NEXT, NSEQALL, NSEQRIV, NSEQMAX -USE YOS_CMF_MAP, ONLY: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH, D2RIVHGT -USE YOS_CMF_MAP, ONLY: D2RIVLEN, D2RIVMAN, I2MASK, D2DWNELV -USE YOS_CMF_PROG, ONLY: P2RIVSTO, D2RIVOUT, P2FLDSTO, D2FLDOUT -USE YOS_CMF_PROG, ONLY: D2RIVOUT_PRE, D2RIVDPH_PRE, D2FLDOUT_PRE, D2FLDSTO_PRE -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2RIVVEL, D2FLDDPH, D2SFCELV -IMPLICIT NONE -!*** Local -REAL(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elevation (t-1) [m] -REAL(KIND=JPRB) :: D2FLDDPH_PRE(NSEQMAX,1) !! floodplain depth (t-1) [m] -! -INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ -REAL(KIND=JPRB),SAVE :: DSLOPE, DOUT_PRE, DFLW, DFLW_PRE, DFLW_IMP, DAREA , DVEL -REAL(KIND=JPRB),SAVE :: DSLOPE_F, DOUT_PRE_F, DFLW_F, DFLW_PRE_F, DFLW_IMP_F, DARE_F, DVEL_F, DARE_PRE_F, DARE_IMP_F -REAL(KIND=JPRB),SAVE :: DSFCMAX, DSFCMAX_PRE + END SUBROUTINE CMF_CALC_OUTFLW_KINE + !#################################################################### + + + + + + !#################################################################### + SUBROUTINE CMF_CALC_OUTFLW_KINEMIX + ! Calculate discharge, mix kinematic & local inertial, depending on slope + USE PARKIND1, only: JPIM, JPRB, JPRD + USE YOS_CMF_INPUT, only: DT, LFLDOUT + USE YOS_CMF_INPUT, only: PDSTMTH, PMANFLD, PGRV , PMINSLP + USE YOS_CMF_MAP, only: I1NEXT, NSEQALL, NSEQRIV, NSEQMAX + USE YOS_CMF_MAP, only: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH, D2RIVHGT + USE YOS_CMF_MAP, only: D2RIVLEN, D2RIVMAN, I2MASK, D2DWNELV + USE YOS_CMF_PROG, only: P2RIVSTO, D2RIVOUT, P2FLDSTO, D2FLDOUT + USE YOS_CMF_PROG, only: D2RIVOUT_PRE, D2RIVDPH_PRE, D2FLDOUT_PRE, D2FLDSTO_PRE + USE YOS_CMF_DIAG, only: D2RIVDPH, D2RIVVEL, D2FLDDPH, D2SFCELV + IMPLICIT NONE + !*** Local + real(KIND=JPRB) :: D2SFCELV_PRE(NSEQMAX,1) !! water surface elevation (t-1) [m] + real(KIND=JPRB) :: D2FLDDPH_PRE(NSEQMAX,1) !! floodplain depth (t-1) [m] + ! + integer(KIND=JPIM),SAVE :: ISEQ, JSEQ + real(KIND=JPRB),SAVE :: DSLOPE, DOUT_PRE, DFLW, DFLW_PRE, DFLW_IMP, DAREA , DVEL + real(KIND=JPRB),SAVE :: DSLOPE_F, DOUT_PRE_F, DFLW_F, DFLW_PRE_F, DFLW_IMP_F, DARE_F, DVEL_F, DARE_PRE_F, DARE_IMP_F + real(KIND=JPRB),SAVE :: DSFCMAX, DSFCMAX_PRE !$OMP THREADPRIVATE (JSEQ, DSLOPE, DOUT_PRE, DFLW, DFLW_PRE, DFLW_IMP, DAREA, DVEL) !$OMP THREADPRIVATE ( DSLOPE_F, DOUT_PRE_F, DFLW_F, DFLW_PRE_F, DFLW_IMP_F, DARE_F, DVEL_F, DARE_PRE_F, DARE_IMP_F) !$OMP THREADPRIVATE ( DSFCMAX, DSFCMAX_PRE) !================================================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) - D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1) - D2FLDDPH_PRE(ISEQ,1) = MAX( D2RIVDPH_PRE(ISEQ,1)-D2RIVHGT(ISEQ,1), 0._JPRB ) -END DO + DO ISEQ=1, NSEQALL + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + D2SFCELV_PRE(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1) + D2FLDDPH_PRE(ISEQ,1) = MAX( D2RIVDPH_PRE(ISEQ,1)-D2RIVHGT(ISEQ,1), 0._JPRB ) + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO -DO ISEQ=1, NSEQRIV !! for normal cells - JSEQ=I1NEXT(ISEQ) ! next cell's pixel - - IF (I2MASK(ISEQ,1) == 0 ) THEN - DSFCMAX =MAX( D2SFCELV(ISEQ,1), D2SFCELV(JSEQ,1) ) - DSFCMAX_PRE=MAX( D2SFCELV_PRE(ISEQ,1),D2SFCELV_PRE(JSEQ,1) ) - DSLOPE = ( D2SFCELV(ISEQ,1)-D2SFCELV(JSEQ,1) ) * D2NXTDST(ISEQ,1)**(-1.) - DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] - - !=== River Flow === - DFLW = DSFCMAX - D2RIVELV(ISEQ,1) !! flow cross-section depth - DAREA = D2RIVWTH(ISEQ,1) * DFLW !! flow cross-section area - - DFLW_PRE=DSFCMAX_PRE - D2RIVELV(ISEQ,1) - DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5 ,1.E-6_JPRB ) !! semi implicit flow depth - - IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN - DOUT_PRE= D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) !! outflow (t-1) [m2/s] (unit width) - D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1.) - ELSE - D2RIVOUT(ISEQ,1) = 0._JPRB - D2RIVVEL(ISEQ,1) = 0._JPRB - ENDIF - - !=== Floodplain Flow === - IF( LFLDOUT )THEN - DFLW_F = MAX( DSFCMAX-D2ELEVTN(ISEQ,1), 0._JPRB ) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - DFLW_PRE_F = DSFCMAX_PRE - D2ELEVTN(ISEQ,1) - DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) - - DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area - DARE_IMP_F = max( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) - - IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN - DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) - D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & - * (1. + PGRV*DT*PMANFLD**2. * abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1.) - ELSE - D2FLDOUT(ISEQ,1) = 0._JPRB - ENDIF + DO ISEQ=1, NSEQRIV !! for normal cells + JSEQ=I1NEXT(ISEQ) ! next cell's pixel - IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization - ENDIF - - ELSE - ! Kinematic wave, river flow - DSLOPE = (D2ELEVTN(ISEQ,1)-D2ELEVTN(JSEQ,1)) * D2NXTDST(ISEQ,1)**(-1.) - DSLOPE = max(DSLOPE,PMINSLP) - DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) - DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) - - D2RIVVEL(ISEQ,1) = DVEL - D2RIVOUT(ISEQ,1) = DAREA * DVEL - D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) - !! kinematic wave, floodplain flow - IF( LFLDOUT )THEN - DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set max&min [instead of using weir equation for efficiency] - DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.D0) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F - D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) - ENDIF - ENDIF + IF (I2MASK(ISEQ,1) == 0 ) THEN + DSFCMAX =MAX( D2SFCELV(ISEQ,1), D2SFCELV(JSEQ,1) ) + DSFCMAX_PRE=MAX( D2SFCELV_PRE(ISEQ,1),D2SFCELV_PRE(JSEQ,1) ) + DSLOPE = ( D2SFCELV(ISEQ,1)-D2SFCELV(JSEQ,1) ) * D2NXTDST(ISEQ,1)**(-1.) + DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] + + !=== River Flow === + DFLW = DSFCMAX - D2RIVELV(ISEQ,1) !! flow cross-section depth + DAREA = D2RIVWTH(ISEQ,1) * DFLW !! flow cross-section area + + DFLW_PRE=DSFCMAX_PRE - D2RIVELV(ISEQ,1) + DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5 ,1.E-6_JPRB ) !! semi implicit flow depth + + IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN + DOUT_PRE= D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) !! outflow (t-1) [m2/s] (unit width) + D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1.) + ELSE + D2RIVOUT(ISEQ,1) = 0._JPRB + D2RIVVEL(ISEQ,1) = 0._JPRB + ENDIF + + !=== Floodplain Flow === + IF( LFLDOUT )THEN + DFLW_F = MAX( DSFCMAX-D2ELEVTN(ISEQ,1), 0._JPRB ) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + DFLW_PRE_F = DSFCMAX_PRE - D2ELEVTN(ISEQ,1) + DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) + + DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area + DARE_IMP_F = max( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) + + IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN + DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) + D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & + * (1. + PGRV*DT*PMANFLD**2. * abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1.) + ELSE + D2FLDOUT(ISEQ,1) = 0._JPRB + ENDIF + + IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization + ENDIF + + ELSE + ! Kinematic wave, river flow + DSLOPE = (D2ELEVTN(ISEQ,1)-D2ELEVTN(JSEQ,1)) * D2NXTDST(ISEQ,1)**(-1.) + DSLOPE = max(DSLOPE,PMINSLP) + DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) + DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) + + D2RIVVEL(ISEQ,1) = DVEL + D2RIVOUT(ISEQ,1) = DAREA * DVEL + D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) + !! kinematic wave, floodplain flow + IF( LFLDOUT )THEN + DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set max&min [instead of using weir equation for efficiency] + DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.D0) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F + D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) + ENDIF + ENDIF -END DO + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO !! for river mouth grids -DO ISEQ=NSEQRIV+1, NSEQALL - IF (I2MASK(ISEQ,1) == 0 ) THEN - - DSLOPE = ( D2SFCELV(ISEQ,1) - D2DWNELV(ISEQ,1) ) * PDSTMTH ** (-1.) - DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] - !=== river mouth flow === - - DFLW = D2RIVDPH(ISEQ,1) - DAREA = D2RIVWTH(ISEQ,1) * DFLW - - DFLW_PRE=D2RIVDPH_PRE(ISEQ,1) - DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5, 1.E-6_JPRB ) !! semi implicit flow depth - - IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN - DOUT_PRE = D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) - D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & - * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) - D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1.) - ELSE - D2RIVOUT(ISEQ,1) = 0._JPRB - D2RIVVEL(ISEQ,1) = 0._JPRB - ENDIF - - !=== floodplain mouth flow === - IF( LFLDOUT )THEN - DFLW_F = D2SFCELV(ISEQ,1)-D2ELEVTN(ISEQ,1) - - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - DFLW_PRE_F = D2SFCELV_PRE(ISEQ,1)-D2ELEVTN(ISEQ,1) - DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) - - DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area - DARE_IMP_F = max( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) - - IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN - DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) - D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & - * (1. + PGRV*DT*PMANFLD**2.*abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1.) - ELSE - D2FLDOUT(ISEQ,1) = 0._JPRB - ENDIF - - IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization - ENDIF - - ELSE - ! Kinematic approach, river channel flow - DSLOPE = PMINSLP - DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) - DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) - - D2RIVVEL(ISEQ,1) = DVEL - D2RIVOUT(ISEQ,1) = DAREA * DVEL - D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) - - !! kinematic wave, floodplain flow - IF( LFLDOUT )THEN - DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set max&min [instead of using weir equation for efficiency] - DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F - D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) - ENDIF - ENDIF -END DO + DO ISEQ=NSEQRIV+1, NSEQALL + IF (I2MASK(ISEQ,1) == 0 ) THEN + + DSLOPE = ( D2SFCELV(ISEQ,1) - D2DWNELV(ISEQ,1) ) * PDSTMTH ** (-1.) + DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] + !=== river mouth flow === + + DFLW = D2RIVDPH(ISEQ,1) + DAREA = D2RIVWTH(ISEQ,1) * DFLW + + DFLW_PRE=D2RIVDPH_PRE(ISEQ,1) + DFLW_IMP=MAX( (DFLW*DFLW_PRE)**0.5, 1.E-6_JPRB ) !! semi implicit flow depth + + IF( DFLW_IMP>1.E-5 .and. DAREA>1.E-5 )THEN + DOUT_PRE = D2RIVOUT_PRE(ISEQ,1) * D2RIVWTH(ISEQ,1)**(-1.) + D2RIVOUT(ISEQ,1) = D2RIVWTH(ISEQ,1) * ( DOUT_PRE + PGRV*DT*DFLW_IMP*DSLOPE ) & + * ( 1. + PGRV*DT*D2RIVMAN(ISEQ,1)**2. * abs(DOUT_PRE)*DFLW_IMP**(-7./3.) )**(-1.) + D2RIVVEL(ISEQ,1) = D2RIVOUT(ISEQ,1) * DAREA**(-1.) + ELSE + D2RIVOUT(ISEQ,1) = 0._JPRB + D2RIVVEL(ISEQ,1) = 0._JPRB + ENDIF + + !=== floodplain mouth flow === + IF( LFLDOUT )THEN + DFLW_F = D2SFCELV(ISEQ,1)-D2ELEVTN(ISEQ,1) + + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + DFLW_PRE_F = D2SFCELV_PRE(ISEQ,1)-D2ELEVTN(ISEQ,1) + DFLW_IMP_F = MAX( (MAX(DFLW_F*DFLW_PRE_F,0._JPRB))**0.5, 1.E-6_JPRB ) + + DARE_PRE_F = D2FLDSTO_PRE(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_PRE_F = MAX( DARE_PRE_F - D2FLDDPH_PRE(ISEQ,1)*D2RIVWTH(ISEQ,1), 1.E-6_JPRB ) !! remove above river channel area + DARE_IMP_F = max( (DARE_F*DARE_PRE_F)**0.5, 1.E-6_JPRB ) + + IF( DFLW_IMP_F>1.E-5 .and. DARE_IMP_F>1.E-5 )THEN + DOUT_PRE_F = D2FLDOUT_PRE(ISEQ,1) + D2FLDOUT(ISEQ,1) = ( DOUT_PRE_F + PGRV*DT*DARE_IMP_F*DSLOPE_F ) & + * (1. + PGRV*DT*PMANFLD**2.*abs(DOUT_PRE_F)*DFLW_IMP_F**(-4./3.)*DARE_IMP_F**(-1.) )**(-1.) + ELSE + D2FLDOUT(ISEQ,1) = 0._JPRB + ENDIF + + IF( D2FLDOUT(ISEQ,1)*D2RIVOUT(ISEQ,1)<0._JPRB ) D2FLDOUT(ISEQ,1)=0._JPRB !! stabilization + ENDIF + + ELSE + ! Kinematic approach, river channel flow + DSLOPE = PMINSLP + DVEL = D2RIVMAN(ISEQ,1)**(-1.) * DSLOPE**0.5 * D2RIVDPH(ISEQ,1)**(2./3.) + DAREA = D2RIVWTH(ISEQ,1) * D2RIVDPH(ISEQ,1) + + D2RIVVEL(ISEQ,1) = DVEL + D2RIVOUT(ISEQ,1) = DAREA * DVEL + D2RIVOUT(ISEQ,1) = MIN( D2RIVOUT(ISEQ,1)*1._JPRD, P2RIVSTO(ISEQ,1)/DT ) + + !! kinematic wave, floodplain flow + IF( LFLDOUT )THEN + DSLOPE_F = min( 0.005_JPRB,DSLOPE ) !! set max&min [instead of using weir equation for efficiency] + DVEL_F = PMANFLD**(-1.) * DSLOPE_F**0.5 * D2FLDDPH(ISEQ,1)**(2./3.) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + D2FLDOUT(ISEQ,1) = DARE_F * DVEL_F + D2FLDOUT(ISEQ,1) = MIN( D2FLDOUT(ISEQ,1)*1._JPRD, P2FLDSTO(ISEQ,1)/DT ) + ENDIF + ENDIF + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE CMF_CALC_OUTFLW_KINEMIX + END SUBROUTINE CMF_CALC_OUTFLW_KINEMIX !#################################################################### -!#################################################################### -SUBROUTINE CMF_CALC_OUTPRE -! to Calculate discharge, diffusive wave, initialization for storage only restart -USE PARKIND1, ONLY: JPIM, JPRB -USE YOS_CMF_INPUT, ONLY: LFLDOUT, LPTHOUT -USE YOS_CMF_INPUT, ONLY: PMANFLD, PDSTMTH -USE YOS_CMF_MAP, ONLY: I1NEXT, NSEQALL, NSEQRIV, NPTHOUT -USE YOS_CMF_MAP, ONLY: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH, D2RIVLEN, D2RIVMAN, D2DWNELV -USE YOS_CMF_MAP, ONLY: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN, PTH_DST, PTH_ELV, PTH_WTH, PTH_MAN -USE YOS_CMF_PROG, ONLY: D2RIVOUT_PRE, D2FLDOUT_PRE, D1PTHFLW_PRE ,D2RIVDPH_PRE !! output -USE YOS_CMF_PROG, ONLY: P2FLDSTO !! input -USE YOS_CMF_DIAG, ONLY: D2RIVDPH, D2SFCELV, D2FLDDPH !! input -IMPLICIT NONE -INTEGER(KIND=JPIM),SAVE :: ISEQ, JSEQ, IPTH, ILEV, ISEQP, JSEQP -REAL(KIND=JPRB),SAVE :: DSFCMAX, DSLOPE, DAREA, DFLW, DSLOPE_F, DARE_F, DFLW_F + !#################################################################### + SUBROUTINE CMF_CALC_OUTPRE + ! to Calculate discharge, diffusive wave, initialization for storage only restart + USE PARKIND1, only: JPIM, JPRB + USE YOS_CMF_INPUT, only: LFLDOUT, LPTHOUT + USE YOS_CMF_INPUT, only: PMANFLD, PDSTMTH + USE YOS_CMF_MAP, only: I1NEXT, NSEQALL, NSEQRIV, NPTHOUT + USE YOS_CMF_MAP, only: D2RIVELV, D2ELEVTN, D2NXTDST, D2RIVWTH, D2RIVLEN, D2RIVMAN, D2DWNELV + USE YOS_CMF_MAP, only: NPTHOUT, NPTHLEV, PTH_UPST, PTH_DOWN, PTH_DST, PTH_ELV, PTH_WTH, PTH_MAN + USE YOS_CMF_PROG, only: D2RIVOUT_PRE, D2FLDOUT_PRE, D1PTHFLW_PRE ,D2RIVDPH_PRE !! output + USE YOS_CMF_PROG, only: P2FLDSTO !! input + USE YOS_CMF_DIAG, only: D2RIVDPH, D2SFCELV, D2FLDDPH !! input + IMPLICIT NONE + integer(KIND=JPIM),SAVE :: ISEQ, JSEQ, IPTH, ILEV, ISEQP, JSEQP + real(KIND=JPRB),SAVE :: DSFCMAX, DSLOPE, DAREA, DFLW, DSLOPE_F, DARE_F, DFLW_F !$OMP THREADPRIVATE (DSFCMAX, DSLOPE, DAREA, DFLW, DSLOPE_F, DARE_F, DFLW_F, JSEQ, ILEV, ISEQP, JSEQP) !================================================ !$OMP PARALLEL DO -DO ISEQ=1, NSEQALL - D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) - D2RIVDPH_PRE(ISEQ,1) = D2RIVDPH(ISEQ,1) !! bugfix v362 -END DO + DO ISEQ=1, NSEQALL + D2SFCELV(ISEQ,1) = D2RIVELV(ISEQ,1) + D2RIVDPH(ISEQ,1) + D2RIVDPH_PRE(ISEQ,1) = D2RIVDPH(ISEQ,1) !! bugfix v362 + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO -DO ISEQ=1, NSEQRIV !! for normal cells - JSEQ=I1NEXT(ISEQ) - - DSFCMAX =MAX( D2SFCELV(ISEQ,1), D2SFCELV(JSEQ,1) ) - DSLOPE = ( D2SFCELV(ISEQ,1)-D2SFCELV(JSEQ,1) ) * D2NXTDST(ISEQ,1)**(-1.) - DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] - -!=== River Flow === - DFLW = DSFCMAX - D2RIVELV(ISEQ,1) - DAREA = D2RIVWTH(ISEQ,1) * DFLW - - IF( DAREA>1.E-5 )THEN - D2RIVOUT_PRE(ISEQ,1) = DAREA * ( D2RIVMAN(ISEQ,1)**(-1.) * DFLW**(2./3.) * abs(DSLOPE)**(0.5) ) - IF( DSLOPE<0._JPRB ) D2RIVOUT_PRE(ISEQ,1)=-D2RIVOUT_PRE(ISEQ,1) - ELSE - D2RIVOUT_PRE(ISEQ,1) = 0._JPRB - ENDIF - -!=== Floodplain Flow === - DFLW_F = MAX( DSFCMAX-D2ELEVTN(ISEQ,1), 0._JPRB ) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - - IF( DARE_F>1.E-5 )THEN - D2FLDOUT_PRE(ISEQ,1) = DARE_F * ( PMANFLD**(-1.) * DFLW_F**(2./3.) * abs(DSLOPE_F)**(0.5) ) - IF( DSLOPE_F<0._JPRB ) D2FLDOUT_PRE(ISEQ,1)=-D2FLDOUT_PRE(ISEQ,1) - ELSE - D2FLDOUT_PRE(ISEQ,1) = 0._JPRB - ENDIF -END DO + DO ISEQ=1, NSEQRIV !! for normal cells + JSEQ=I1NEXT(ISEQ) + + DSFCMAX =MAX( D2SFCELV(ISEQ,1), D2SFCELV(JSEQ,1) ) + DSLOPE = ( D2SFCELV(ISEQ,1)-D2SFCELV(JSEQ,1) ) * D2NXTDST(ISEQ,1)**(-1.) + DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] + + !=== River Flow === + DFLW = DSFCMAX - D2RIVELV(ISEQ,1) + DAREA = D2RIVWTH(ISEQ,1) * DFLW + + IF( DAREA>1.E-5 )THEN + D2RIVOUT_PRE(ISEQ,1) = DAREA * ( D2RIVMAN(ISEQ,1)**(-1.) * DFLW**(2./3.) * abs(DSLOPE)**(0.5) ) + IF( DSLOPE<0._JPRB ) D2RIVOUT_PRE(ISEQ,1)=-D2RIVOUT_PRE(ISEQ,1) + ELSE + D2RIVOUT_PRE(ISEQ,1) = 0._JPRB + ENDIF + + !=== Floodplain Flow === + DFLW_F = MAX( DSFCMAX-D2ELEVTN(ISEQ,1), 0._JPRB ) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + + IF( DARE_F>1.E-5 )THEN + D2FLDOUT_PRE(ISEQ,1) = DARE_F * ( PMANFLD**(-1.) * DFLW_F**(2./3.) * abs(DSLOPE_F)**(0.5) ) + IF( DSLOPE_F<0._JPRB ) D2FLDOUT_PRE(ISEQ,1)=-D2FLDOUT_PRE(ISEQ,1) + ELSE + D2FLDOUT_PRE(ISEQ,1) = 0._JPRB + ENDIF + ENDDO !$OMP END PARALLEL DO !$OMP PARALLEL DO !! for river mouth grids -DO ISEQ=NSEQRIV+1, NSEQALL - DSLOPE = ( D2SFCELV(ISEQ,1)-D2DWNELV(ISEQ,1) ) * PDSTMTH**(-1.) - DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] - -!=== river mouth flow === - DFLW = D2RIVDPH(ISEQ,1) - DAREA = D2RIVWTH(ISEQ,1) * DFLW - IF( DAREA>1.E-5 )THEN - D2RIVOUT_PRE(ISEQ,1) = DAREA * ( D2RIVMAN(ISEQ,1)**(-1.) * DFLW**(2./3.) * abs(DSLOPE)**(0.5) ) - IF( DSLOPE<0._JPRB ) D2RIVOUT_PRE(ISEQ,1)=-D2RIVOUT_PRE(ISEQ,1) - ELSE - D2RIVOUT_PRE(ISEQ,1) = 0._JPRB - ENDIF -!=== floodplain mouth flow === - DFLW_F = MAX(D2SFCELV(ISEQ,1)-D2ELEVTN(ISEQ,1), 0._JPRB) - DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) - DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area - IF( DARE_F>1.E-5 )THEN - D2FLDOUT_PRE(ISEQ,1) = DARE_F * ( PMANFLD**(-1.) * DFLW_F**(2./3.) * abs(DSLOPE_F)**(0.5) ) - IF( DSLOPE_F<0._JPRB ) D2FLDOUT_PRE(ISEQ,1)=-D2FLDOUT_PRE(ISEQ,1) - ELSE - D2FLDOUT_PRE(ISEQ,1) = 0._JPRB - ENDIF -END DO + DO ISEQ=NSEQRIV+1, NSEQALL + DSLOPE = ( D2SFCELV(ISEQ,1)-D2DWNELV(ISEQ,1) ) * PDSTMTH**(-1.) + DSLOPE_F = MAX( -0.005_JPRB, min( 0.005_JPRB,DSLOPE )) !! set max&min [instead of using weir equation for efficiency] + + !=== river mouth flow === + DFLW = D2RIVDPH(ISEQ,1) + DAREA = D2RIVWTH(ISEQ,1) * DFLW + IF( DAREA>1.E-5 )THEN + D2RIVOUT_PRE(ISEQ,1) = DAREA * ( D2RIVMAN(ISEQ,1)**(-1.) * DFLW**(2./3.) * abs(DSLOPE)**(0.5) ) + IF( DSLOPE<0._JPRB ) D2RIVOUT_PRE(ISEQ,1)=-D2RIVOUT_PRE(ISEQ,1) + ELSE + D2RIVOUT_PRE(ISEQ,1) = 0._JPRB + ENDIF + !=== floodplain mouth flow === + DFLW_F = MAX(D2SFCELV(ISEQ,1)-D2ELEVTN(ISEQ,1), 0._JPRB) + DARE_F = P2FLDSTO(ISEQ,1) * D2RIVLEN(ISEQ,1)**(-1.) + DARE_F = MAX( DARE_F - D2FLDDPH(ISEQ,1)*D2RIVWTH(ISEQ,1), 0._JPRB ) !! remove above river channel area + IF( DARE_F>1.E-5 )THEN + D2FLDOUT_PRE(ISEQ,1) = DARE_F * ( PMANFLD**(-1.) * DFLW_F**(2./3.) * abs(DSLOPE_F)**(0.5) ) + IF( DSLOPE_F<0._JPRB ) D2FLDOUT_PRE(ISEQ,1)=-D2FLDOUT_PRE(ISEQ,1) + ELSE + D2FLDOUT_PRE(ISEQ,1) = 0._JPRB + ENDIF + ENDDO +!$OMP END PARALLEL DO + + + IF( LPTHOUT )THEN +!$OMP PARALLEL DO + DO IPTH=1, NPTHOUT + ISEQP=PTH_UPST(IPTH) + JSEQP=PTH_DOWN(IPTH) + + DSLOPE = (D2SFCELV(ISEQP,1)-D2SFCELV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) + DO ILEV=1, NPTHLEV + DFLW = MAX(D2SFCELV(ISEQP,1),D2SFCELV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) + DFLW = MAX(DFLW,0._JPRB) + + IF( DFLW>1.E-5 )THEN + D1PTHFLW_PRE(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * DFLW * & + ( PTH_MAN(ILEV)**(-1.) * DFLW**(2./3.) * abs(DSLOPE)**(0.5) ) + IF( DSLOPE<0._JPRB ) D1PTHFLW_PRE(IPTH,ILEV)=-D1PTHFLW_PRE(IPTH,ILEV) + ELSE + D1PTHFLW_PRE(IPTH,ILEV) = 0._JPRB + ENDIF + ENDDO + ENDDO !$OMP END PARALLEL DO + ENDIF + !! when high-water flow is not defined + IF( .not. LFLDOUT )THEN + D2FLDOUT_PRE(:,:)=0.D0 + ENDIF -IF( LPTHOUT )THEN - !$OMP PARALLEL DO - DO IPTH=1, NPTHOUT - ISEQP=PTH_UPST(IPTH) - JSEQP=PTH_DOWN(IPTH) - - DSLOPE = (D2SFCELV(ISEQP,1)-D2SFCELV(JSEQP,1)) * PTH_DST(IPTH)**(-1.) - DO ILEV=1, NPTHLEV - DFLW = MAX(D2SFCELV(ISEQP,1),D2SFCELV(JSEQP,1)) - PTH_ELV(IPTH,ILEV) - DFLW = MAX(DFLW,0._JPRB) - - IF( DFLW>1.E-5 )THEN - D1PTHFLW_PRE(IPTH,ILEV) = PTH_WTH(IPTH,ILEV) * DFLW * ( PTH_MAN(ILEV)**(-1.) * DFLW**(2./3.) * abs(DSLOPE)**(0.5) ) - IF( DSLOPE<0._JPRB ) D1PTHFLW_PRE(IPTH,ILEV)=-D1PTHFLW_PRE(IPTH,ILEV) - ELSE - D1PTHFLW_PRE(IPTH,ILEV) = 0._JPRB - ENDIF - END DO - END DO - !$OMP END PARALLEL DO -ENDIF - -!! when high-water flow is not defined -IF( .not. LFLDOUT )THEN - D2FLDOUT_PRE(:,:)=0.D0 -ENDIF - -END SUBROUTINE CMF_CALC_OUTPRE + END SUBROUTINE CMF_CALC_OUTPRE !#################################################################### -!#################################################################### -SUBROUTINE CMF_CALC_OUTINS -! to Calculate discharge, INST. NO ROUTING DELAY -USE PARKIND1, ONLY: JPIM, JPRB -USE YOS_CMF_MAP, ONLY: I1NEXT, NSEQMAX -USE YOS_CMF_PROG, ONLY: D2RUNOFF -USE YOS_CMF_DIAG, ONLY: D2OUTINS -IMPLICIT NONE -!!** LOCAL -INTEGER(KIND=JPIM) :: ISEQ,JSEQ -!!============================== -D2OUTINS(:,:)=D2RUNOFF(:,:) - -!! Do not use OpenMP -DO ISEQ=1, NSEQMAX - JSEQ=I1NEXT(ISEQ) - IF( JSEQ>0 )THEN - D2OUTINS(JSEQ,1)=D2OUTINS(JSEQ,1)+D2OUTINS(ISEQ,1) - ENDIF -END DO - -END SUBROUTINE CMF_CALC_OUTINS -!#################################################################### + !#################################################################### + SUBROUTINE CMF_CALC_OUTINS + ! to Calculate discharge, INST. NO ROUTING DELAY + USE PARKIND1, only: JPIM, JPRB + USE YOS_CMF_MAP, only: I1NEXT, NSEQMAX + USE YOS_CMF_PROG, only: D2RUNOFF + USE YOS_CMF_DIAG, only: D2OUTINS + IMPLICIT NONE + !!** LOCAL + integer(KIND=JPIM) :: ISEQ,JSEQ + !!============================== + D2OUTINS(:,:)=D2RUNOFF(:,:) + + !! Do not use OpenMP + DO ISEQ=1, NSEQMAX + JSEQ=I1NEXT(ISEQ) + IF( JSEQ>0 )THEN + D2OUTINS(JSEQ,1)=D2OUTINS(JSEQ,1)+D2OUTINS(ISEQ,1) + ENDIF + ENDDO + + END SUBROUTINE CMF_CALC_OUTINS + !#################################################################### END MODULE CMF_OPT_OUTFLW_MOD diff --git a/CaMa/src/cmf_utils_mod.F90 b/CaMa/src/cmf_utils_mod.F90 index 45176d34..f48970c3 100755 --- a/CaMa/src/cmf_utils_mod.F90 +++ b/CaMa/src/cmf_utils_mod.F90 @@ -11,15 +11,15 @@ MODULE CMF_UTILS_MOD ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM, JPRD -USE YOS_CMF_INPUT, ONLY: LOGNAM, DMIS, RMIS, NX,NY -USE YOS_CMF_MAP, ONLY: NSEQMAX, NSEQALL -IMPLICIT NONE + USE PARKIND1, only: JPIM, JPRB, JPRM, JPRD + USE YOS_CMF_INPUT, only: LOGNAM, DMIS, RMIS, NX,NY + USE YOS_CMF_MAP, only: NSEQMAX, NSEQALL + IMPLICIT NONE CONTAINS !#################################################################### ! map related subroutines & functions -!-- vecP2mapR : convert 1D vector data -> 2D map data (REAL*4) -!-- vecD2mapD : convert 1D vector data -> 2D map data (REAL*8) +!-- vecP2mapR : convert 1D vector data -> 2D map data (real*4) +!-- vecD2mapD : convert 1D vector data -> 2D map data (real*8) !-- mapR2vecD : convert 2D map data -> 1D vector data (REAL*4) !-- mapP2vecP : convert 2D map data -> 1D vector data (REAL*8) !-- mapI2vecI : convert 2D map data -> 1D vector data (Integer) @@ -41,527 +41,527 @@ MODULE CMF_UTILS_MOD !-- INQUIRE_FID : inruire unused file FID !-- NCERROR : netCDF I/O wrapper !#################################################################### -SUBROUTINE vecD2mapR(D2VEC,R2MAP) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRB),INTENT(IN) :: D2VEC(NSEQMAX,1) -REAL(KIND=JPRM),INTENT(OUT) :: R2MAP(NX,NY) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY,ISEQ + SUBROUTINE vecD2mapR(D2VEC,R2MAP) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRB),intent(in) :: D2VEC(NSEQMAX,1) + real(KIND=JPRM),intent(out) :: R2MAP(NX,NY) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY,ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ -R2MAP(:,:) = RMIS + R2MAP(:,:) = RMIS !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - R2MAP(IX,IY) = REAL(D2VEC(ISEQ,1),KIND=JPRM) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + R2MAP(IX,IY) = real(D2VEC(ISEQ,1),KIND=JPRM) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE vecD2mapR -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE vecD2mapD(D2VEC,D2MAP) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRB),INTENT(IN) :: D2VEC(NSEQMAX,1) -REAL(KIND=JPRB),INTENT(OUT) :: D2MAP(NX,NY) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY,ISEQ + END SUBROUTINE vecD2mapR + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE vecD2mapD(D2VEC,D2MAP) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRB),intent(in) :: D2VEC(NSEQMAX,1) + real(KIND=JPRB),intent(out) :: D2MAP(NX,NY) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY,ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ -D2MAP(:,:) = DMIS + D2MAP(:,:) = DMIS !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - D2MAP(IX,IY) = D2VEC(ISEQ,1) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + D2MAP(IX,IY) = D2VEC(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE vecD2mapD -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE vecP2mapP(P2VEC,P2MAP) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRD),INTENT(IN) :: P2VEC(NSEQMAX,1) -REAL(KIND=JPRD),INTENT(OUT) :: P2MAP(NX,NY) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY,ISEQ + END SUBROUTINE vecD2mapD + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE vecP2mapP(P2VEC,P2MAP) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRD),intent(in) :: P2VEC(NSEQMAX,1) + real(KIND=JPRD),intent(out) :: P2MAP(NX,NY) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY,ISEQ !$OMP THREADPRIVATE (IX,IY) -!================================================ -P2MAP(:,:) = DMIS + !================================================ + P2MAP(:,:) = DMIS !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - P2MAP(IX,IY) = P2VEC(ISEQ,1) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + P2MAP(IX,IY) = P2VEC(ISEQ,1) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE vecP2mapP -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE vecP2mapR(P2VEC,R2MAP) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRD),INTENT(IN) :: P2VEC(NSEQMAX,1) -REAL(KIND=JPRM),INTENT(OUT) :: R2MAP(NX,NY) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY,ISEQ + END SUBROUTINE vecP2mapP + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE vecP2mapR(P2VEC,R2MAP) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRD),intent(in) :: P2VEC(NSEQMAX,1) + real(KIND=JPRM),intent(out) :: R2MAP(NX,NY) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY,ISEQ !$OMP THREADPRIVATE (IX,IY) -!================================================ -R2MAP(:,:) = RMIS + !================================================ + R2MAP(:,:) = RMIS !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - R2MAP(IX,IY) = REAL(P2VEC(ISEQ,1),4) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + R2MAP(IX,IY) = real(P2VEC(ISEQ,1),4) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE vecP2mapR -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE mapR2vecD(R2TEMP,D2VAR) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRM),INTENT(IN) :: R2TEMP(NX,NY) -REAL(KIND=JPRB),INTENT(OUT) :: D2VAR(NSEQMAX,1) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY, ISEQ + END SUBROUTINE vecP2mapR + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE mapR2vecD(R2TEMP,D2VAR) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRM),intent(in) :: R2TEMP(NX,NY) + real(KIND=JPRB),intent(out) :: D2VAR(NSEQMAX,1) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY, ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - D2VAR(ISEQ,1) = REAL(R2TEMP(IX,IY),KIND=JPRB) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + D2VAR(ISEQ,1) = real(R2TEMP(IX,IY),KIND=JPRB) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE mapR2vecD -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE mapD2vecD(D2TEMP,D2VAR) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRB),INTENT(IN) :: D2TEMP(NX,NY) -REAL(KIND=JPRB),INTENT(OUT) :: D2VAR(NSEQMAX,1) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY, ISEQ + END SUBROUTINE mapR2vecD + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE mapD2vecD(D2TEMP,D2VAR) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRB),intent(in) :: D2TEMP(NX,NY) + real(KIND=JPRB),intent(out) :: D2VAR(NSEQMAX,1) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY, ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - D2VAR(ISEQ,1) = D2TEMP(IX,IY) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + D2VAR(ISEQ,1) = D2TEMP(IX,IY) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE mapD2vecD -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE mapP2vecP(P2TEMP,P2VAR) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRD),INTENT(IN) :: P2TEMP(NX,NY) -REAL(KIND=JPRD),INTENT(OUT) :: P2VAR(NSEQMAX,1) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY, ISEQ + END SUBROUTINE mapD2vecD + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE mapP2vecP(P2TEMP,P2VAR) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRD),intent(in) :: P2TEMP(NX,NY) + real(KIND=JPRD),intent(out) :: P2VAR(NSEQMAX,1) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY, ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - P2VAR(ISEQ,1) = P2TEMP(IX,IY) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + P2VAR(ISEQ,1) = P2TEMP(IX,IY) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE mapP2vecP -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE mapP2vecD(P2TEMP,D2VAR) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -REAL(KIND=JPRD),INTENT(IN) :: P2TEMP(NX,NY) -REAL(KIND=JPRB),INTENT(OUT) :: D2VAR(NSEQMAX,1) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY, ISEQ + END SUBROUTINE mapP2vecP + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE mapP2vecD(P2TEMP,D2VAR) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + real(KIND=JPRD),intent(in) :: P2TEMP(NX,NY) + real(KIND=JPRB),intent(out) :: D2VAR(NSEQMAX,1) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY, ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - D2VAR(ISEQ,1) = P2TEMP(IX,IY) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + D2VAR(ISEQ,1) = P2TEMP(IX,IY) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE mapP2vecD -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE mapI2vecI(I2TEMP,I2VAR) -USE YOS_CMF_MAP, ONLY: I1SEQX,I1SEQY -IMPLICIT NONE -!* input/output -INTEGER(KIND=JPIM),INTENT(IN) :: I2TEMP(NX,NY) -INTEGER(KIND=JPIM),INTENT(OUT) :: I2VAR(NSEQMAX,1) -!* local variable -INTEGER(KIND=JPIM),SAVE :: IX,IY,ISEQ + END SUBROUTINE mapP2vecD + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE mapI2vecI(I2TEMP,I2VAR) + USE YOS_CMF_MAP, only: I1SEQX,I1SEQY + IMPLICIT NONE + !* input/output + integer(KIND=JPIM),intent(in) :: I2TEMP(NX,NY) + integer(KIND=JPIM),intent(out) :: I2VAR(NSEQMAX,1) + !* local variable + integer(KIND=JPIM),SAVE :: IX,IY,ISEQ !$OMP THREADPRIVATE (IX,IY) !================================================ !$OMP PARALLEL DO -DO ISEQ=1,NSEQALL - IX=I1SEQX(ISEQ) - IY=I1SEQY(ISEQ) - I2VAR(ISEQ,1) = I2TEMP(IX,IY) -ENDDO + DO ISEQ=1,NSEQALL + IX=I1SEQX(ISEQ) + IY=I1SEQY(ISEQ) + I2VAR(ISEQ,1) = I2TEMP(IX,IY) + ENDDO !$OMP END PARALLEL DO -END SUBROUTINE mapI2vecI + END SUBROUTINE mapI2vecI !#################################################################### -!#################################################################### -! time related subroutines & functions -! -- MIN2DATE : calculate DATE of KMIN from base time (YYYY0,MM0,DD0) -! -- DATE2MIN : convert (YYYYMMDD,HHMM) to KMIN from base time (YYYY0,MM0,DD0) -! -- SPLITDATE : splite date (YYYYMMDD) to (YYYY,MM,DD) -! -- SPLITHOUR : split hour (HHMM) to (HH,MM) -! -- IMDAYS : function to calculate days in a monty IMDAYS(IYEAR,IMON) -!========================================================== -SUBROUTINE MIN2DATE(IMIN,YYYYMMDD,HHMM) -! Return YYYYMMDD and HHMM for IMIN -USE YOS_CMF_TIME, ONLY: YYYY0, MM0, DD0 -IMPLICIT NONE -! local -INTEGER(KIND=JPIM),INTENT(IN) :: IMIN !! input minutes -INTEGER(KIND=JPIM),INTENT(OUT) :: YYYYMMDD -INTEGER(KIND=JPIM),INTENT(OUT) :: HHMM -INTEGER(KIND=JPIM) :: YYYY,MM,DD,HH,MI,NDAYS,NDM,ID -INTEGER(KIND=JPIM) :: D2MIN ! minutes in one day -PARAMETER (D2MIN=1440) -!================================================ -YYYYMMDD = 0 -HHMM = 0 + !#################################################################### + ! time related subroutines & functions + ! -- MIN2DATE : calculate DATE of KMIN from base time (YYYY0,MM0,DD0) + ! -- DATE2MIN : convert (YYYYMMDD,HHMM) to KMIN from base time (YYYY0,MM0,DD0) + ! -- SPLITDATE : splite date (YYYYMMDD) to (YYYY,MM,DD) + ! -- SPLITHOUR : split hour (HHMM) to (HH,MM) + ! -- IMDAYS : function to calculate days in a monty IMDAYS(IYEAR,IMON) + !========================================================== + SUBROUTINE MIN2DATE(IMIN,YYYYMMDD,HHMM) + ! Return YYYYMMDD and HHMM for IMIN + USE YOS_CMF_TIME, only: YYYY0, MM0, DD0 + IMPLICIT NONE + ! local + integer(KIND=JPIM),intent(in) :: IMIN !! input minutes + integer(KIND=JPIM),intent(out) :: YYYYMMDD + integer(KIND=JPIM),intent(out) :: HHMM + integer(KIND=JPIM) :: YYYY,MM,DD,HH,MI,NDAYS,NDM,ID + integer(KIND=JPIM) :: D2MIN ! minutes in one day + parameter (D2MIN=1440) + !================================================ + YYYYMMDD = 0 + HHMM = 0 -NDAYS = IMIN/D2MIN !! days in IMIN : 1440 = (minutes in a day) -MI = MOD(IMIN,D2MIN) -HH = INT(MI/60) !! hours in IMIN -MI = MOD(MI,60) !! mins in IMIN + NDAYS = IMIN/D2MIN !! days in IMIN : 1440 = (minutes in a day) + MI = MOD(IMIN,D2MIN) + HH = INT(MI/60) !! hours in IMIN + MI = MOD(MI,60) !! mins in IMIN -YYYY = YYYY0 -MM = MM0 -DD = DD0 -NDM = IMDAYS(YYYY,MM) !! number of days in a month + YYYY = YYYY0 + MM = MM0 + DD = DD0 + NDM = IMDAYS(YYYY,MM) !! number of days in a month -! WRITE(LOGNAM,*) YYYY,MM,DD -DO ID=1,NDAYS - DD=DD+1 - IF ( DD .GT. NDM ) THEN - MM=MM+1 - DD=1 - IF ( MM .GT. 12 ) THEN - MM=1 - YYYY=YYYY+1 - ENDIF - NDM=IMDAYS(YYYY,MM) - ENDIF -ENDDO + ! write(LOGNAM,*) YYYY,MM,DD + DO ID=1,NDAYS + DD=DD+1 + IF ( DD .gt. NDM ) THEN + MM=MM+1 + DD=1 + IF ( MM .gt. 12 ) THEN + MM=1 + YYYY=YYYY+1 + ENDIF + NDM=IMDAYS(YYYY,MM) + ENDIF + ENDDO -HHMM = HH*100+MI -YYYYMMDD = YYYY*10000+MM*100+DD -END SUBROUTINE MIN2DATE -!========================================================== -!+ -!+ -!+ -!========================================================== -FUNCTION DATE2MIN(YYYYMMDD,HHMM) -! convert (YYYYMMDD,HHMM) to KMIN from base time (YYYY0,MM0,DD0) -USE YOS_CMF_TIME, ONLY: YYYY0 -IMPLICIT NONE -INTEGER(KIND=JPIM) :: DATE2MIN -INTEGER(KIND=JPIM),INTENT(IN) :: YYYYMMDD -INTEGER(KIND=JPIM),INTENT(IN) :: HHMM -INTEGER(KIND=JPIM) :: YYYY,MM,DD,HH,MI -INTEGER(KIND=JPIM) :: IY,IM -INTEGER(KIND=JPIM) :: D2MIN ! minutes in one day -PARAMETER (D2MIN=1440) -!================================================ -DATE2MIN = 0 -CALL SPLITDATE(YYYYMMDD,YYYY,MM,DD) -HH = HHMM/100 !! hour -MI = HHMM-HH*100 !! minute -!============================ -IF ( YYYY .LT. YYYY0) THEN - WRITE(LOGNAM,*) 'DATE2MIN: YYYY .LT. YYYY0: Date Problem', YYYY,YYYY0 - STOP -ENDIF -IF ( MM.LT.1 .or. MM .GT. 12 ) THEN - WRITE(LOGNAM,*) 'DATE2MIN: MM: Date Problem', YYYYMMDD, HHMM - STOP -ENDIF -IF ( DD.LT.1 .or. DD .GT. IMDAYS(YYYY,MM)) THEN - WRITE(LOGNAM,*) 'DATE2MIN: DD: Date Problem', YYYYMMDD, HHMM - STOP -ENDIF -IF ( HH.LT.0 .or. HH .GT. 24) THEN - WRITE(LOGNAM,*) 'DATE2MIN: HH: Date Problem', YYYYMMDD, HHMM - STOP -ENDIF -IF ( MI.LT.0 .or. MI .GT. 60) THEN - WRITE(LOGNAM,*) 'DATE2MIN: MI: Date Problem', YYYYMMDD, HHMM - STOP -ENDIF + HHMM = HH*100+MI + YYYYMMDD = YYYY*10000+MM*100+DD + END SUBROUTINE MIN2DATE + !========================================================== + !+ + !+ + !+ + !========================================================== + FUNCTION DATE2MIN(YYYYMMDD,HHMM) + ! convert (YYYYMMDD,HHMM) to KMIN from base time (YYYY0,MM0,DD0) + USE YOS_CMF_TIME, only: YYYY0 + IMPLICIT NONE + integer(KIND=JPIM) :: DATE2MIN + integer(KIND=JPIM),intent(in) :: YYYYMMDD + integer(KIND=JPIM),intent(in) :: HHMM + integer(KIND=JPIM) :: YYYY,MM,DD,HH,MI + integer(KIND=JPIM) :: IY,IM + integer(KIND=JPIM) :: D2MIN ! minutes in one day + parameter (D2MIN=1440) + !================================================ + DATE2MIN = 0 + CALL SPLITDATE(YYYYMMDD,YYYY,MM,DD) + HH = HHMM/100 !! hour + MI = HHMM-HH*100 !! minute + !============================ + IF ( YYYY .lt. YYYY0) THEN + write(LOGNAM,*) 'DATE2MIN: YYYY .lt. YYYY0: Date Problem', YYYY,YYYY0 + STOP + ENDIF + IF ( MM.lt.1 .or. MM .gt. 12 ) THEN + write(LOGNAM,*) 'DATE2MIN: MM: Date Problem', YYYYMMDD, HHMM + STOP + ENDIF + IF ( DD.lt.1 .or. DD .gt. IMDAYS(YYYY,MM)) THEN + write(LOGNAM,*) 'DATE2MIN: DD: Date Problem', YYYYMMDD, HHMM + STOP + ENDIF + IF ( HH.lt.0 .or. HH .gt. 24) THEN + write(LOGNAM,*) 'DATE2MIN: HH: Date Problem', YYYYMMDD, HHMM + STOP + ENDIF + IF ( MI.lt.0 .or. MI .gt. 60) THEN + write(LOGNAM,*) 'DATE2MIN: MI: Date Problem', YYYYMMDD, HHMM + STOP + ENDIF -IY=YYYY0 -DO WHILE (IY .LT. YYYY) - DO IM=1,12 - DATE2MIN=DATE2MIN+IMDAYS(IY,IM)*D2MIN - ENDDO - IY=IY+1 -ENDDO -IM=1 -DO WHILE (IM .LT. MM ) - DATE2MIN=DATE2MIN+IMDAYS(IY,IM)*D2MIN - IM=IM+1 -ENDDO + IY=YYYY0 + DO WHILE (IY .lt. YYYY) + DO IM=1,12 + DATE2MIN=DATE2MIN+IMDAYS(IY,IM)*D2MIN + ENDDO + IY=IY+1 + ENDDO + IM=1 + DO WHILE (IM .lt. MM ) + DATE2MIN=DATE2MIN+IMDAYS(IY,IM)*D2MIN + IM=IM+1 + ENDDO -DATE2MIN = DATE2MIN + (DD-1)*D2MIN -DATE2MIN = DATE2MIN + HH*60 + MI + DATE2MIN = DATE2MIN + (DD-1)*D2MIN + DATE2MIN = DATE2MIN + HH*60 + MI -END FUNCTION DATE2MIN -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE SPLITDATE(YYYYMMDD,YYYY,MM,DD) -! sprit YYYYMMDD to (YYYY,MM,DD) -IMPLICIT NONE -INTEGER(KIND=JPIM),INTENT(IN) :: YYYYMMDD -INTEGER(KIND=JPIM),INTENT(OUT) :: YYYY,MM,DD -!================================================ -YYYY = YYYYMMDD/10000 -MM = (YYYYMMDD - YYYY*10000) / 100 -DD = YYYYMMDD -(YYYY*10000+MM*100) -END SUBROUTINE SPLITDATE -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE SPLITHOUR(HHMM,HH,MI) -! sprit YYYYMMDD to (YYYY,MM,DD) -IMPLICIT NONE -INTEGER(KIND=JPIM),INTENT(IN) :: HHMM -INTEGER(KIND=JPIM),INTENT(OUT) :: HH,MI -!================================================ -HH=INT(HHMM/100) -MI=INT(HHMM-HH*100) -END SUBROUTINE SPLITHOUR -!========================================================== -!+ -!+ -!+ -!========================================================== -FUNCTION IMDAYS(IYEAR,IMON) -!! days in month -USE YOS_CMF_INPUT, ONLY: LLEAPYR -IMPLICIT NONE -INTEGER(KIND=JPIM) :: IMDAYS -INTEGER(KIND=JPIM),INTENT(IN) :: IYEAR -INTEGER(KIND=JPIM),INTENT(IN) :: IMON -INTEGER(KIND=JPIM) :: ND(12) -DATA ND /31,28,31,30,31,30,31,31,30,31,30,31/ -!================================================ -IMDAYS=ND(IMON) -IF ( IMON == 2 .and. LLEAPYR ) THEN - IF ( MOD(IYEAR,400) == 0 .OR. (MOD(IYEAR,100) .NE. 0 .AND. MOD(IYEAR,4) .EQ. 0 )) IMDAYS=29 -ENDIF -END FUNCTION IMDAYS + END FUNCTION DATE2MIN + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE SPLITDATE(YYYYMMDD,YYYY,MM,DD) + ! sprit YYYYMMDD to (YYYY,MM,DD) + IMPLICIT NONE + integer(KIND=JPIM),intent(in) :: YYYYMMDD + integer(KIND=JPIM),intent(out) :: YYYY,MM,DD + !================================================ + YYYY = YYYYMMDD/10000 + MM = (YYYYMMDD - YYYY*10000) / 100 + DD = YYYYMMDD -(YYYY*10000+MM*100) + END SUBROUTINE SPLITDATE + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE SPLITHOUR(HHMM,HH,MI) + ! sprit YYYYMMDD to (YYYY,MM,DD) + IMPLICIT NONE + integer(KIND=JPIM),intent(in) :: HHMM + integer(KIND=JPIM),intent(out) :: HH,MI + !================================================ + HH=INT(HHMM/100) + MI=INT(HHMM-HH*100) + END SUBROUTINE SPLITHOUR + !========================================================== + !+ + !+ + !+ + !========================================================== + FUNCTION IMDAYS(IYEAR,IMON) + !! days in month + USE YOS_CMF_INPUT, only: LLEAPYR + IMPLICIT NONE + integer(KIND=JPIM) :: IMDAYS + integer(KIND=JPIM),intent(in) :: IYEAR + integer(KIND=JPIM),intent(in) :: IMON + integer(KIND=JPIM) :: ND(12) + DATA ND /31,28,31,30,31,30,31,31,30,31,30,31/ + !================================================ + IMDAYS=ND(IMON) + IF ( IMON == 2 .and. LLEAPYR ) THEN + IF ( MOD(IYEAR,400) == 0 .or. (MOD(IYEAR,100) .NE. 0 .and. MOD(IYEAR,4) .eq. 0 )) IMDAYS=29 + ENDIF + END FUNCTION IMDAYS !========================================================== -!#################################################################### -! endian conversion -!-- CONV_END : Convert 2D Array endian (REAL4) -!-- CONV_ENDI : Convert 2D Array endian (Integer) -!-- ENDIAN4R : byte swap (REAL*4) -!-- ENDIAN4I : byte swap (Integer) -!#################################################################### -SUBROUTINE CONV_END(R2TEMP,NX,NY) -!-- Convert 2D Array endian (REAL4) -IMPLICIT NONE -!* input/output -INTEGER(KIND=JPIM),INTENT(IN) :: NX,NY -REAL(KIND=JPRM),INTENT(INOUT) :: R2TEMP(NX,NY) -!* local variables -INTEGER(KIND=JPIM) :: IY,IX -!================================================ -DO IY=1, NY - DO IX=1, NY - CALL ENDIAN4R(R2TEMP(IX,IY)) - END DO -END DO -END SUBROUTINE CONV_END -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE CONV_ENDI(I2TEMP,NX,NY) -!-- Convert 2D Array endian (INTEGER) -IMPLICIT NONE -!+ input/output -INTEGER(KIND=JPIM),INTENT(IN) :: NX,NY -INTEGER(KIND=JPIM),INTENT(INOUT) :: I2TEMP(NX,NY) -!* local variables -INTEGER(KIND=JPIM) :: IY,IX -!================================================ -DO IY=1, NY - DO IX=1, NY - CALL ENDIAN4I(I2TEMP(IX,IY)) - END DO -END DO -END SUBROUTINE CONV_ENDI -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE ENDIAN4R( realIn ) -!! Byte Swap -! -! Adpated from: http://www.cgd.ucar.edu/cas/software/endian.html -! FILE: SUBR_native_4byte_real.f90 -! SUBPROGRAM: native_4byte_real -! -! AUTHOR: David Stepaniak, NCAR/CGD/CAS -! DATE INITIATED: 29 April 2003 -! LAST MODIFIED: 29 April 2003 -IMPLICIT NONE -!* input/output -REAL(KIND=JPRM), INTENT(INOUT) :: realIn -!* Local variables (generic 32 bit INTEGER spaces): -INTEGER :: i_element -INTEGER :: i_element_br -!================================================ -! Transfer 32 bits of realIn to generic 32 bit INTEGER space: -i_element_br=0 -i_element = TRANSFER( realIn, 0 ) -! Reverse order of 4 bytes in 32 bit INTEGER space: -CALL MVBITS( i_element, 24, 8, i_element_br, 0 ) -CALL MVBITS( i_element, 16, 8, i_element_br, 8 ) -CALL MVBITS( i_element, 8, 8, i_element_br, 16 ) -CALL MVBITS( i_element, 0, 8, i_element_br, 24 ) + !#################################################################### + ! endian conversion + !-- CONV_END : Convert 2D Array endian (REAL4) + !-- CONV_ENDI : Convert 2D Array endian (Integer) + !-- ENDIAN4R : byte swap (real*4) + !-- ENDIAN4I : byte swap (Integer) + !#################################################################### + SUBROUTINE CONV_END(R2TEMP,NX,NY) + !-- Convert 2D Array endian (REAL4) + IMPLICIT NONE + !* input/output + integer(KIND=JPIM),intent(in) :: NX,NY + real(KIND=JPRM),intent(inout) :: R2TEMP(NX,NY) + !* local variables + integer(KIND=JPIM) :: IY,IX + !================================================ + DO IY=1, NY + DO IX=1, NY + CALL ENDIAN4R(R2TEMP(IX,IY)) + ENDDO + ENDDO + END SUBROUTINE CONV_END + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE CONV_ENDI(I2TEMP,NX,NY) + !-- Convert 2D Array endian (integer) + IMPLICIT NONE + !+ input/output + integer(KIND=JPIM),intent(in) :: NX,NY + integer(KIND=JPIM),intent(inout) :: I2TEMP(NX,NY) + !* local variables + integer(KIND=JPIM) :: IY,IX + !================================================ + DO IY=1, NY + DO IX=1, NY + CALL ENDIAN4I(I2TEMP(IX,IY)) + ENDDO + ENDDO + END SUBROUTINE CONV_ENDI + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE ENDIAN4R( realIn ) + !! Byte Swap + ! + ! Adpated from: http://www.cgd.ucar.edu/cas/software/endian.html + ! FILE: SUBR_native_4byte_real.f90 + ! SUBPROGRAM: native_4byte_real + ! + ! AUTHOR: David Stepaniak, NCAR/CGD/CAS + ! DATE INITIATED: 29 April 2003 + ! LAST MODIFIED: 29 April 2003 + IMPLICIT NONE + !* input/output + real(KIND=JPRM), intent(inout) :: realIn + !* Local variables (generic 32 bit integer spaces): + integer :: i_element + integer :: i_element_br + !================================================ + ! Transfer 32 bits of realIn to generic 32 bit integer space: + i_element_br=0 + i_element = TRANSFER( realIn, 0 ) + ! Reverse order of 4 bytes in 32 bit integer space: + CALL MVBITS( i_element, 24, 8, i_element_br, 0 ) + CALL MVBITS( i_element, 16, 8, i_element_br, 8 ) + CALL MVBITS( i_element, 8, 8, i_element_br, 16 ) + CALL MVBITS( i_element, 0, 8, i_element_br, 24 ) -! Transfer reversed order bytes to 32 bit REAL space (realOut): -realIn = TRANSFER( i_element_br, 0.0 ) -END SUBROUTINE ENDIAN4R -!========================================================== -!+ -!+ -!+ -!========================================================== -SUBROUTINE ENDIAN4I(IntIn) -!! Byte Swap -IMPLICIT NONE -!* input/output -INTEGER(KIND=JPIM), INTENT(INOUT) :: IntIn -! Local variables -INTEGER :: i_element -INTEGER :: i_element_br -!================================================ -! Transfer 32 bits of realIn to generic 32 bit INTEGER space: -i_element_br=0 -i_element = TRANSFER( IntIn, 0 ) -! Reverse order of 4 bytes in 32 bit INTEGER space: -CALL MVBITS( i_element, 24, 8, i_element_br, 0 ) -CALL MVBITS( i_element, 16, 8, i_element_br, 8 ) -CALL MVBITS( i_element, 8, 8, i_element_br, 16 ) -CALL MVBITS( i_element, 0, 8, i_element_br, 24 ) + ! Transfer reversed order bytes to 32 bit real space (realOut): + realIn = TRANSFER( i_element_br, 0.0 ) + END SUBROUTINE ENDIAN4R + !========================================================== + !+ + !+ + !+ + !========================================================== + SUBROUTINE ENDIAN4I(IntIn) + !! Byte Swap + IMPLICIT NONE + !* input/output + integer(KIND=JPIM), intent(inout) :: IntIn + ! Local variables + integer :: i_element + integer :: i_element_br + !================================================ + ! Transfer 32 bits of realIn to generic 32 bit integer space: + i_element_br=0 + i_element = TRANSFER( IntIn, 0 ) + ! Reverse order of 4 bytes in 32 bit integer space: + CALL MVBITS( i_element, 24, 8, i_element_br, 0 ) + CALL MVBITS( i_element, 16, 8, i_element_br, 8 ) + CALL MVBITS( i_element, 8, 8, i_element_br, 16 ) + CALL MVBITS( i_element, 0, 8, i_element_br, 24 ) - intIn = i_element_br -END SUBROUTINE ENDIAN4I -!#################################################################### + intIn = i_element_br + END SUBROUTINE ENDIAN4I + !#################################################################### -!#################################################################### -! file I/O -!-- INQUIRE_FID : inruire unused file FID -!-- NCERROR : netCDF I/O wrapper -!#################################################################### -FUNCTION INQUIRE_FID() RESULT(FID) -IMPLICIT NONE -!* input/output -INTEGER :: FID !< FILE ID -!* local variable -LOGICAL :: I_OPENED !< FILE ID IS ALREADY USED OR NOT? -!================================================ -DO FID = 10, 999 - INQUIRE(FID,OPENED=I_OPENED) - IF ( .NOT. I_OPENED ) RETURN -ENDDO -END FUNCTION INQUIRE_FID -!========================================================== -!+ -!+ -!+ -!========================================================== + !#################################################################### + ! file I/O + !-- INQUIRE_FID : inruire unused file FID + !-- NCERROR : netCDF I/O wrapper + !#################################################################### + FUNCTION INQUIRE_FID() RESULT(FID) + IMPLICIT NONE + !* input/output + integer :: FID !< FILE ID + !* local variable + logical :: I_OPENED !< FILE ID IS ALREADY USED or not? + !================================================ + DO FID = 10, 999 + INQUIRE(FID,OPENED=I_OPENED) + IF ( .not. I_OPENED ) RETURN + ENDDO + END FUNCTION INQUIRE_FID + !========================================================== + !+ + !+ + !+ + !========================================================== #ifdef UseCDF_CMF -SUBROUTINE NCERROR(STATUS,STRING) -!! NETCDF error handling -USE NETCDF -IMPLICIT NONE -INTEGER,INTENT(IN) :: STATUS -CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: STRING -!================================================ -IF ( STATUS /= 0 ) THEN - WRITE(LOGNAM,*) TRIM(NF90_STRERROR(STATUS)) - IF( PRESENT(STRING) ) WRITE(LOGNAM,*) TRIM(STRING) - WRITE(LOGNAM,*) 'PROGRAM STOP ! ' - STOP 10 -ENDIF -END SUBROUTINE NCERROR + SUBROUTINE NCERROR(STATUS,STRING) + !! NETCDF error handling + USE NETCDF + IMPLICIT NONE + integer,intent(in) :: STATUS + character(LEN=*),intent(in),OPTIONAL :: STRING + !================================================ + IF ( STATUS /= 0 ) THEN + write(LOGNAM,*) TRIM(NF90_STRERROR(STATUS)) + IF( PRESENT(STRING) ) write(LOGNAM,*) TRIM(STRING) + write(LOGNAM,*) 'PROGRAM STOP ! ' + STOP 10 + ENDIF + END SUBROUTINE NCERROR #endif !#################################################################### diff --git a/CaMa/src/parkind1.F90 b/CaMa/src/parkind1.F90 index f97909b3..e5c9c15d 100755 --- a/CaMa/src/parkind1.F90 +++ b/CaMa/src/parkind1.F90 @@ -11,37 +11,37 @@ MODULE PARKIND1 ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -IMPLICIT NONE -SAVE -!================================================ -!*** Integer Kinds -INTEGER, PARAMETER :: JPIT = SELECTED_INT_KIND(2) -INTEGER, PARAMETER :: JPIS = SELECTED_INT_KIND(4) -INTEGER, PARAMETER :: JPIM = SELECTED_INT_KIND(9) -INTEGER, PARAMETER :: JPIB = SELECTED_INT_KIND(12) -!Special integer type to be used for sensative adress calculations -!should be *8 for a machine with 8byte adressing for optimum performance + IMPLICIT NONE + SAVE + !================================================ + !*** Integer Kinds + integer,parameter :: JPIT = SELECTED_INT_KIND(2) + integer,parameter :: JPIS = SELECTED_INT_KIND(4) + integer,parameter :: JPIM = SELECTED_INT_KIND(9) + integer,parameter :: JPIB = SELECTED_INT_KIND(12) + !Special integer type to be used for sensative adress calculations + !should be *8 for a machine with 8byte adressing for optimum performance #ifdef ADDRESS64 -INTEGER, PARAMETER :: JPIA = JPIB + integer,parameter :: JPIA = JPIB #else -INTEGER, PARAMETER :: JPIA = JPIM + integer,parameter :: JPIA = JPIM #endif -!================================================ -!*** Real Kinds -INTEGER, PARAMETER :: JPRT = SELECTED_REAL_KIND(2,1) -INTEGER, PARAMETER :: JPRS = SELECTED_REAL_KIND(4,2) -INTEGER, PARAMETER :: JPRM = SELECTED_REAL_KIND(6,37) + !================================================ + !*** Real Kinds + integer,parameter :: JPRT = SELECTED_REAL_KIND(2,1) + integer,parameter :: JPRS = SELECTED_REAL_KIND(4,2) + integer,parameter :: JPRM = SELECTED_REAL_KIND(6,37) #ifdef SinglePrec_CMF -INTEGER, PARAMETER :: JPRB = SELECTED_REAL_KIND(6,37) + integer,parameter :: JPRB = SELECTED_REAL_KIND(6,37) #else -INTEGER, PARAMETER :: JPRB = SELECTED_REAL_KIND(13,300) + integer,parameter :: JPRB = SELECTED_REAL_KIND(13,300) #endif -! Double real for C code and special places requiring -! higher precision. -INTEGER, PARAMETER :: JPRD = SELECTED_REAL_KIND(13,300) + ! Double real for C code and special places requiring + ! higher precision. + integer,parameter :: JPRD = SELECTED_REAL_KIND(13,300) -!================================================ -! Logical Kinds for RTTOV.... -INTEGER, PARAMETER :: JPLM = JPIM !Standard logical type + !================================================ + ! Logical Kinds for RTTOV.... + integer,parameter :: JPLM = JPIM !Standard logical type END MODULE PARKIND1 diff --git a/CaMa/src/sediment/cmf_calc_sedflw_mod.F90 b/CaMa/src/sediment/cmf_calc_sedflw_mod.F90 index fedaca13..10fccc62 100755 --- a/CaMa/src/sediment/cmf_calc_sedflw_mod.F90 +++ b/CaMa/src/sediment/cmf_calc_sedflw_mod.F90 @@ -1,404 +1,403 @@ -module cmf_calc_sedflw_mod +MODULE cmf_calc_sedflw_mod !========================================================== !* PURPOSE: physics for sediment transport ! (C) M.Hatono (Hiroshima-U) May 2021 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -contains +CONTAINS !#################################################################### ! -- CMF_CALC_SEDFLW ! -- ! -- !#################################################################### -subroutine cmf_calc_sedflw - use PARKIND1, only: JPIM, JPRB - use YOS_CMF_INPUT, only: PGRV - use YOS_CMF_MAP, only: D2RIVLEN, D2RIVWTH, NSEQALL - use YOS_CMF_PROG, only: P2RIVSTO - use YOS_CMF_DIAG, only: D2RIVDPH - use yos_cmf_sed, only: lambda, nsed, sedDT, setVel, & - d2layer, d2sedcon, d2rivsto_pre - use sed_utils_mod, only: sed_diag_average, sed_diag_reset + SUBROUTINE cmf_calc_sedflw + USE PARKIND1, only: JPIM, JPRB + USE YOS_CMF_INPUT, only: PGRV + USE YOS_CMF_MAP, only: D2RIVLEN, D2RIVWTH, NSEQALL + USE YOS_CMF_PROG, only: P2RIVSTO + USE YOS_CMF_DIAG, only: D2RIVDPH + USE yos_cmf_sed, only: lambda, nsed, sedDT, setVel, & + d2layer, d2sedcon, d2rivsto_pre + USE sed_utils_mod, only: sed_diag_average, sed_diag_reset - implicit none - !$ SAVE - save - integer(kind=JPIM) :: ISEQ - real(kind=JPRB) :: sedsto(NSEQALL,nsed) - real(kind=JPRB) :: shearVel(NSEQALL) - real(kind=JPRB) :: critShearVel(NSEQALL,nsed), dMean(NSEQALL), susVel(NSEQALL,nsed) - real(kind=JPRB), parameter :: IGNORE_DPH = 0.05d0 - !================================================ + IMPLICIT NONE + !$ SAVE + SAVE + integer(kind=JPIM) :: ISEQ + real(kind=JPRB) :: sedsto(NSEQALL,nsed) + real(kind=JPRB) :: shearVel(NSEQALL) + real(kind=JPRB) :: critShearVel(NSEQALL,nsed), dMean(NSEQALL), susVel(NSEQALL,nsed) + real(kind=JPRB), parameter :: IGNORE_DPH = 0.05d0 + !================================================ - call sed_diag_average + CALL sed_diag_average !$omp parallel do - do iseq = 1, NSEQALL - sedsto(iseq,:) = d2sedcon(iseq,:) * max(d2rivsto_pre(iseq), 0.d0) - enddo - !$omp end parallel do + DO iseq = 1, NSEQALL + sedsto(iseq,:) = d2sedcon(iseq,:) * max(d2rivsto_pre(iseq), 0.d0) + ENDDO + !$omp END parallel DO - call calc_params - call calc_advection - call calc_entrainment - call calc_exchange + CALL calc_params + CALL calc_advection + CALL calc_entrainment + CALL calc_exchange - !$omp parallel do - do iseq = 1, NSEQALL - if ( P2RIVSTO(iseq,1) < D2RIVWTH(iseq,1)*D2RIVLEN(iseq,1)*IGNORE_DPH ) cycle - d2sedcon(iseq,:) = sedsto(iseq,:) / P2RIVSTO(iseq,1) - enddo - !$omp end parallel do + !$omp parallel DO + DO iseq = 1, NSEQALL + IF ( P2RIVSTO(iseq,1) < D2RIVWTH(iseq,1)*D2RIVLEN(iseq,1)*IGNORE_DPH ) CYCLE + d2sedcon(iseq,:) = sedsto(iseq,:) / P2RIVSTO(iseq,1) + ENDDO + !$omp END parallel DO - call sed_diag_reset + CALL sed_diag_reset -contains -!========================================================== -!+ calc_params -!+ calc_advection -!+ calc_entrainment -!+ calc_exchange -!========================================================== - subroutine calc_params - use yos_cmf_sed, only: pset, revEgia, sDiam, visKin, d2rivvel_sed - use cmf_calc_sedpar_mod, only: calc_criticalShearVelocity, calc_shearVelocity, calc_suspendVelocity - implicit none - save - integer(kind=JPIM) :: ised, iseq - real(kind=JPRB) :: csVel0, sTmp, sTmp1(nsed) - !===================================================== - - do iseq = 1, NSEQALL - !-------------------------! - ! critical shear velocity ! - !-------------------------! + CONTAINS + !========================================================== + !+ calc_params + !+ calc_advection + !+ calc_entrainment + !+ calc_exchange + !========================================================== + SUBROUTINE calc_params + USE yos_cmf_sed, only: pset, revEgia, sDiam, visKin, d2rivvel_sed + USE cmf_calc_sedpar_mod, only: calc_criticalShearVelocity, calc_shearVelocity, calc_suspendVelocity + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: ised, iseq + real(kind=JPRB) :: csVel0, sTmp, sTmp1(nsed) + !===================================================== - if ( sum(d2layer(iseq,:)) <= 0.d0 ) then - critShearVel(iseq,:) = 1e20 - else if ( revEgia ) then - dMean(iseq) = 0.d0 - do ised = 1, nsed - dMean(iseq) = dMean(iseq) + sDiam(ised)*d2layer(iseq,ised)/sum(d2layer(iseq,:)) - enddo - csVel0 = calc_criticalShearVelocity(dMean(iseq)) - do ised = 1, nsed - if ( sDiam(ised) / dMean(iseq) >= 0.4d0 ) then - critShearVel(iseq,ised) = sqrt( csVel0*sDiam(ised)/dMean(iseq) ) * & - & ( log10(19.d0)/log10(19.d0*sDiam(ised)/dMean(iseq)) ) * 0.01d0 - else - critShearVel(iseq,ised) = sqrt( 0.85*csVel0 ) * 0.01d0 - endif - enddo - else - do ised = 1, nsed - critShearVel(iseq,ised) = sqrt( calc_criticalShearVelocity(sDiam(ised)) ) * 0.01d0 - enddo - endif - - !------------------------------------------------------! - ! shear velocity, suspend velocity, Karman coefficient ! - !------------------------------------------------------! - if ( d2rivvel_sed(iseq) == 0.d0 .or. D2RIVDPH(iseq,1) < IGNORE_DPH ) then - shearVel(iseq) = 0.d0 - susVel(iseq,:) = 0.d0 - else - shearVel(iseq) = calc_shearVelocity(d2rivvel_sed(iseq), D2RIVDPH(iseq,1)) - susVel(iseq,:) = calc_suspendVelocity(critShearVel(iseq,:), shearVel(iseq), setVel(:)) - endif - enddo - end subroutine calc_params - !===================================================== + DO iseq = 1, NSEQALL + !-------------------------! + ! critical shear velocity ! + !-------------------------! + + IF ( sum(d2layer(iseq,:)) <= 0.d0 ) THEN + critShearVel(iseq,:) = 1e20 + ELSE IF ( revEgia ) THEN + dMean(iseq) = 0.d0 + DO ised = 1, nsed + dMean(iseq) = dMean(iseq) + sDiam(ised)*d2layer(iseq,ised)/sum(d2layer(iseq,:)) + ENDDO + csVel0 = calc_criticalShearVelocity(dMean(iseq)) + DO ised = 1, nsed + IF ( sDiam(ised) / dMean(iseq) >= 0.4d0 ) THEN + critShearVel(iseq,ised) = sqrt( csVel0*sDiam(ised)/dMean(iseq) ) * & + & ( log10(19.d0)/log10(19.d0*sDiam(ised)/dMean(iseq)) ) * 0.01d0 + ELSE + critShearVel(iseq,ised) = sqrt( 0.85*csVel0 ) * 0.01d0 + ENDIF + ENDDO + ELSE + DO ised = 1, nsed + critShearVel(iseq,ised) = sqrt( calc_criticalShearVelocity(sDiam(ised)) ) * 0.01d0 + ENDDO + ENDIF + + !------------------------------------------------------! + ! shear velocity, suspend velocity, Karman coefficient ! + !------------------------------------------------------! + IF ( d2rivvel_sed(iseq) == 0.d0 .or. D2RIVDPH(iseq,1) < IGNORE_DPH ) THEN + shearVel(iseq) = 0.d0 + susVel(iseq,:) = 0.d0 + ELSE + shearVel(iseq) = calc_shearVelocity(d2rivvel_sed(iseq), D2RIVDPH(iseq,1)) + susVel(iseq,:) = calc_suspendVelocity(critShearVel(iseq,:), shearVel(iseq), setVel(:)) + ENDIF + ENDDO + END SUBROUTINE calc_params + !===================================================== - subroutine calc_advection - use YOS_CMF_MAP, only: I1NEXT - use yos_cmf_sed, only: d2rivout_sed, d2bedout, d2sedout, & - d2bedout_avg, d2sedout_avg, psedD, pwatD - implicit none - real(kind=JPRB) :: bOut(NSEQALL,nsed), brate(NSEQALL,nsed) - real(kind=JPRB) :: sOut(NSEQALL,nsed), srate(NSEQALL,nsed) - integer(kind=JPIM) :: ised, iseq - ! save for omop - real(kind=JPRB), save :: plusVel, minusVel - integer(kind=JPIM), save :: iseq0, iseq1 - !$omp threadprivate ( plusVel, minusVel, iseq0, iseq1 ) - !======== - - bOut(:,:) = 0.d0 - sOut(:,:) = 0.d0 - !$omp parallel do - do iseq = 1, NSEQALL - - if ( d2rivout_sed(iseq) >= 0.d0 ) then - iseq0 = iseq - iseq1 = I1NEXT(iseq) - else - iseq0 = I1NEXT(iseq) - iseq1 = iseq - endif + SUBROUTINE calc_advection + USE YOS_CMF_MAP, only: I1NEXT + USE yos_cmf_sed, only: d2rivout_sed, d2bedout, d2sedout, & + d2bedout_avg, d2sedout_avg, psedD, pwatD + IMPLICIT NONE + real(kind=JPRB) :: bOut(NSEQALL,nsed), brate(NSEQALL,nsed) + real(kind=JPRB) :: sOut(NSEQALL,nsed), srate(NSEQALL,nsed) + integer(kind=JPIM) :: ised, iseq + ! SAVE for omop + real(kind=JPRB), SAVE :: plusVel, minusVel + integer(kind=JPIM), SAVE :: iseq0, iseq1 +!$omp threadprivate ( plusVel, minusVel, iseq0, iseq1 ) + !======== + bOut(:,:) = 0.d0 + sOut(:,:) = 0.d0 +!$omp parallel DO + DO iseq = 1, NSEQALL + + IF ( d2rivout_sed(iseq) >= 0.d0 ) THEN + iseq0 = iseq + iseq1 = I1NEXT(iseq) + ELSE + iseq0 = I1NEXT(iseq) + iseq1 = iseq + ENDIF - if ( d2rivout_sed(iseq) == 0.d0 ) then - d2sedout(iseq,:) = 0.d0 - d2bedout(iseq,:) = 0.d0 - cycle - endif + IF ( d2rivout_sed(iseq) == 0.d0 ) THEN + d2sedout(iseq,:) = 0.d0 + d2bedout(iseq,:) = 0.d0 + CYCLE + ENDIF - !-------------------! - ! calc suspend flow ! - !-------------------! - if ( iseq0 < 0 ) then - d2sedout(iseq,:) = d2sedcon(iseq1,:) * d2rivout_sed(iseq) - else - d2sedout(iseq,:) = d2sedcon(iseq0,:) * d2rivout_sed(iseq) - sOut(iseq0,:) = sOut(iseq0,:) + abs(d2sedout(iseq,:))*sedDT - endif + !-------------------! + ! calc suspend flow ! + !-------------------! + IF ( iseq0 < 0 ) THEN + d2sedout(iseq,:) = d2sedcon(iseq1,:) * d2rivout_sed(iseq) + ELSE + d2sedout(iseq,:) = d2sedcon(iseq0,:) * d2rivout_sed(iseq) + sOut(iseq0,:) = sOut(iseq0,:) + abs(d2sedout(iseq,:))*sedDT + ENDIF - !--------------! - ! calc bedflow ! - !--------------! - if ( minval(critShearVel(iseq,:)) >= shearVel(iseq) .or. sum(d2layer(iseq,:)) == 0.d0 .or. iseq0 < 0 ) then - d2bedout(iseq,:) = 0.d0 - else - do ised = 1, nsed - if ( critShearVel(iseq,ised) >= shearVel(iseq) .or. d2layer(iseq,ised) == 0.d0 ) then - d2bedout(iseq,ised) = 0.d0 - cycle - endif - plusVel = shearVel(iseq) + critShearVel(iseq,ised) - minusVel = shearVel(iseq) - critShearVel(iseq,ised) - d2bedout(iseq,ised) = 17.d0 * D2RIVWTH(iseq,1) * plusVel * minusVel * minusVel & - & / ((psedD-pwatD)/pwatD) / PGRV * d2layer(iseq,ised) / sum(d2layer(iseq,:)) - bOut(iseq0,ised) = bOut(iseq0,ised) + d2bedout(iseq,ised)*sedDT - enddo - endif - enddo - !$omp end parallel do + !--------------! + ! calc bedflow ! + !--------------! + IF ( minval(critShearVel(iseq,:)) >= shearVel(iseq) .or. sum(d2layer(iseq,:)) == 0.d0 .or. iseq0 < 0 ) THEN + d2bedout(iseq,:) = 0.d0 + ELSE + DO ised = 1, nsed + IF ( critShearVel(iseq,ised) >= shearVel(iseq) .or. d2layer(iseq,ised) == 0.d0 ) THEN + d2bedout(iseq,ised) = 0.d0 + CYCLE + ENDIF + plusVel = shearVel(iseq) + critShearVel(iseq,ised) + minusVel = shearVel(iseq) - critShearVel(iseq,ised) + d2bedout(iseq,ised) = 17.d0 * D2RIVWTH(iseq,1) * plusVel * minusVel * minusVel & + & / ((psedD-pwatD)/pwatD) / PGRV * d2layer(iseq,ised) / sum(d2layer(iseq,:)) + bOut(iseq0,ised) = bOut(iseq0,ised) + d2bedout(iseq,ised)*sedDT + ENDDO + ENDIF + ENDDO +!$omp END parallel DO - !--------------------------------------------! - ! adjust outflow if larget than sedsto/layer ! - !--------------------------------------------! - brate(:,:) = 1.d0 - srate(:,:) = 1.d0 - !$omp parallel do - do iseq = 1, NSEQALL - if ( minval(sOut(iseq,:)) <= 1e-8 ) then - do ised = 1, nsed - if ( sOut(iseq,ised) > 1e-8 ) then - srate(iseq,ised) = min ( sedsto(iseq,ised) / sOut(iseq,ised), 1.d0 ) - endif - enddo - else - srate(iseq,:) = min ( sedsto(iseq,:) / sOut(iseq,:), 1.d0 ) - endif - if ( minval(bOut(iseq,:)) <= 1e-8 ) then - do ised = 1, nsed - if ( bOut(iseq,ised) > 1e-8 ) then - brate(iseq,ised) = min( d2layer(iseq,ised) / bOut(iseq,ised), 1.d0 ) - endif - enddo - else - brate(iseq,:) = min( d2layer(iseq,:) / bOut(iseq,:), 1.d0 ) - endif - enddo - !$omp end parallel do + !--------------------------------------------! + ! adjust outflow IF larget than sedsto/layer ! + !--------------------------------------------! + brate(:,:) = 1.d0 + srate(:,:) = 1.d0 +!$omp parallel DO + DO iseq = 1, NSEQALL + IF ( minval(sOut(iseq,:)) <= 1e-8 ) THEN + DO ised = 1, nsed + IF ( sOut(iseq,ised) > 1e-8 ) THEN + srate(iseq,ised) = min ( sedsto(iseq,ised) / sOut(iseq,ised), 1.d0 ) + ENDIF + ENDDO + ELSE + srate(iseq,:) = min ( sedsto(iseq,:) / sOut(iseq,:), 1.d0 ) + ENDIF + IF ( minval(bOut(iseq,:)) <= 1e-8 ) THEN + DO ised = 1, nsed + IF ( bOut(iseq,ised) > 1e-8 ) THEN + brate(iseq,ised) = min( d2layer(iseq,ised) / bOut(iseq,ised), 1.d0 ) + ENDIF + ENDDO + ELSE + brate(iseq,:) = min( d2layer(iseq,:) / bOut(iseq,:), 1.d0 ) + ENDIF + ENDDO +!$omp END parallel DO - do iseq = 1, NSEQALL - if ( d2rivout_sed(iseq) >= 0.d0 ) then - iseq0 = iseq - iseq1 = I1NEXT(iseq) - else - iseq0 = I1NEXT(iseq) - iseq1 = iseq - endif + DO iseq = 1, NSEQALL + IF ( d2rivout_sed(iseq) >= 0.d0 ) THEN + iseq0 = iseq + iseq1 = I1NEXT(iseq) + ELSE + iseq0 = I1NEXT(iseq) + iseq1 = iseq + ENDIF - if ( iseq0 > 0 ) then - d2sedout(iseq,:) = d2sedout(iseq,:) * srate(iseq0,:) - sedsto(iseq0,:) = max( sedsto(iseq0,:)-abs(d2sedout(iseq,:))*sedDT, 0.d0 ) - d2bedout(iseq,:) = d2bedout(iseq,:) * brate(iseq0,:) - d2layer(iseq0,:) = max( d2layer(iseq0,:)-abs(d2bedout(iseq,:))*sedDT, 0.d0 ) - endif - if ( iseq1 > 0 ) then - sedsto(iseq1,:) = max( sedsto(iseq1,:)+abs(d2sedout(iseq,:))*sedDT, 0.d0 ) - d2layer(iseq1,:) = max( d2layer(iseq1,:)+abs(d2bedout(iseq,:))*sedDT, 0.d0 ) - endif + IF ( iseq0 > 0 ) THEN + d2sedout(iseq,:) = d2sedout(iseq,:) * srate(iseq0,:) + sedsto(iseq0,:) = max( sedsto(iseq0,:)-abs(d2sedout(iseq,:))*sedDT, 0.d0 ) + d2bedout(iseq,:) = d2bedout(iseq,:) * brate(iseq0,:) + d2layer(iseq0,:) = max( d2layer(iseq0,:)-abs(d2bedout(iseq,:))*sedDT, 0.d0 ) + ENDIF + IF ( iseq1 > 0 ) THEN + sedsto(iseq1,:) = max( sedsto(iseq1,:)+abs(d2sedout(iseq,:))*sedDT, 0.d0 ) + d2layer(iseq1,:) = max( d2layer(iseq1,:)+abs(d2bedout(iseq,:))*sedDT, 0.d0 ) + ENDIF - d2bedout_avg(iseq,:) = d2bedout_avg(iseq,:) + d2bedout(iseq,:)*sedDT - d2sedout_avg(iseq,:) = d2sedout_avg(iseq,:) + d2sedout(iseq,:)*sedDT - enddo + d2bedout_avg(iseq,:) = d2bedout_avg(iseq,:) + d2bedout(iseq,:)*sedDT + d2sedout_avg(iseq,:) = d2sedout_avg(iseq,:) + d2sedout(iseq,:)*sedDT + ENDDO - end subroutine calc_advection + END SUBROUTINE calc_advection !===================================================== - subroutine calc_entrainment - use yos_cmf_sed, only: vonKar, d2netflw, d2netflw_avg, d2sedinp, d2seddep, totlyrnum - - implicit none - real(kind=JPRB) :: dTmp(NSEQALL,nsed), D(NSEQALL,nsed), Es(NSEQALL,nsed), Zd(NSEQALL,nsed) - integer(kind=JPIM) :: ilyr, ised, iseq - real(kind=JPRB),save :: dTmp1, layerP - !$omp threadprivate ( dTmp1, layerP ) - !======== + SUBROUTINE calc_entrainment + USE yos_cmf_sed, only: vonKar, d2netflw, d2netflw_avg, d2sedinp, d2seddep, totlyrnum + + IMPLICIT NONE + real(kind=JPRB) :: dTmp(NSEQALL,nsed), D(NSEQALL,nsed), Es(NSEQALL,nsed), Zd(NSEQALL,nsed) + integer(kind=JPIM) :: ilyr, ised, iseq + real(kind=JPRB),SAVE :: dTmp1, layerP +!$omp threadprivate ( dTmp1, layerP ) +!======== - !$omp parallel do - do iseq = 1, NSEQALL - if ( D2RIVDPH(iseq,1) < IGNORE_DPH ) then - d2netflw(iseq,:) = 0.d0 - cycle - endif +!$omp parallel DO + DO iseq = 1, NSEQALL + IF ( D2RIVDPH(iseq,1) < IGNORE_DPH ) THEN + d2netflw(iseq,:) = 0.d0 + CYCLE + ENDIF - !----------------------! - ! calculate suspension ! - !----------------------! - if ( sum(d2layer(iseq,:)) == 0.d0 .or. all(susVel(iseq,:)==0.d0) ) then - Es(iseq,:) = 0.d0 - else - Es(iseq,:) = susVel(iseq,:) * (1.d0-lambda) * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2layer(iseq,:) / sum(d2layer(iseq,:)) - Es(iseq,:) = max( Es(iseq,:), 0.d0 ) - endif + !----------------------! + ! calculate suspension ! + !----------------------! + IF ( sum(d2layer(iseq,:)) == 0.d0 .or. all(susVel(iseq,:)==0.d0) ) THEN + Es(iseq,:) = 0.d0 + ELSE + Es(iseq,:) = susVel(iseq,:) * (1.d0-lambda) * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2layer(iseq,:) / sum(d2layer(iseq,:)) + Es(iseq,:) = max( Es(iseq,:), 0.d0 ) + ENDIF - !----------------------! - ! calculate deposition ! - !----------------------! - if ( shearVel(iseq) == 0.d0 .or. all(setVel(:)==0.d0) ) then - D(iseq,:) = 0.d0 - else - Zd(iseq,:) = 6.d0 * setVel(:) / vonKar / shearVel(iseq) - D(iseq,:) = setVel(:) * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2sedcon(iseq,:) * Zd(iseq,:) / (1.d0-exp(-Zd(iseq,:))) - D(iseq,:) = max( D(iseq,:), 0.d0 ) - endif - d2netflw(iseq,:) = Es(iseq,:) - D(iseq,:) - - !-------------------------------------------! - ! if >0, suspension ; if <0, deposition ! - ! adjust netflw if larger than sedsto/layer ! - !-------------------------------------------! - do ised = 1, nsed - if ( d2netflw(iseq,ised) == 0.d0 ) then - cycle - else if ( d2netflw(iseq,ised) > 0.d0 ) then - dTmp1 = d2netflw(iseq,ised)*sedDT/(1.d0-lambda) - if ( dTmp1 < d2layer(iseq,ised) ) then - d2layer(iseq,ised) = d2layer(iseq,ised) - dTmp1 - else - d2netflw(iseq,ised) = d2layer(iseq,ised) * (1.d0-lambda) / sedDT - d2layer(iseq,ised) = 0.d0 - endif - sedsto(iseq,ised) = sedsto(iseq,ised) + d2netflw(iseq,ised) * sedDT - else - if ( abs(d2netflw(iseq,ised))*sedDT < sedsto(iseq,ised) ) then - sedsto(iseq,ised) = max (sedsto(iseq,ised) - abs(d2netflw(iseq,ised))*sedDT, 0.d0 ) - else - d2netflw(iseq,ised) = - sedsto(iseq,ised) / sedDT - sedsto(iseq,ised) = 0.d0 - endif - d2layer(iseq,ised) = d2layer(iseq,ised) + abs(d2netflw(iseq,ised))*sedDT/(1.d0-lambda) - endif - enddo + !----------------------! + ! calculate deposition ! + !----------------------! + IF ( shearVel(iseq) == 0.d0 .or. all(setVel(:)==0.d0) ) THEN + D(iseq,:) = 0.d0 + ELSE + Zd(iseq,:) = 6.d0 * setVel(:) / vonKar / shearVel(iseq) + D(iseq,:) = setVel(:) * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2sedcon(iseq,:) * Zd(iseq,:) / (1.d0-exp(-Zd(iseq,:))) + D(iseq,:) = max( D(iseq,:), 0.d0 ) + ENDIF + d2netflw(iseq,:) = Es(iseq,:) - D(iseq,:) + + !-------------------------------------------! + ! IF >0, suspension ; IF <0, deposition ! + ! adjust netflw IF larger than sedsto/layer ! + !-------------------------------------------! + DO ised = 1, nsed + IF ( d2netflw(iseq,ised) == 0.d0 ) THEN + CYCLE + ELSE IF ( d2netflw(iseq,ised) > 0.d0 ) THEN + dTmp1 = d2netflw(iseq,ised)*sedDT/(1.d0-lambda) + IF ( dTmp1 < d2layer(iseq,ised) ) THEN + d2layer(iseq,ised) = d2layer(iseq,ised) - dTmp1 + ELSE + d2netflw(iseq,ised) = d2layer(iseq,ised) * (1.d0-lambda) / sedDT + d2layer(iseq,ised) = 0.d0 + ENDIF + sedsto(iseq,ised) = sedsto(iseq,ised) + d2netflw(iseq,ised) * sedDT + ELSE + IF ( abs(d2netflw(iseq,ised))*sedDT < sedsto(iseq,ised) ) THEN + sedsto(iseq,ised) = max (sedsto(iseq,ised) - abs(d2netflw(iseq,ised))*sedDT, 0.d0 ) + ELSE + d2netflw(iseq,ised) = - sedsto(iseq,ised) / sedDT + sedsto(iseq,ised) = 0.d0 + ENDIF + d2layer(iseq,ised) = d2layer(iseq,ised) + abs(d2netflw(iseq,ised))*sedDT/(1.d0-lambda) + ENDIF + ENDDO - sedsto(iseq,:) = sedsto(iseq,:) + d2sedinp(iseq,:)*sedDT - if ( sum(sedsto(iseq,:)) > P2RIVSTO(iseq,1) * 0.01d0 ) then - dTmp(iseq,:) = ( sum(sedsto(iseq,:)) - P2RIVSTO(iseq,1)*0.01d0 ) * sedsto(iseq,:)/sum(sedsto(iseq,:)) - d2netflw(iseq,:) = d2netflw(iseq,:) - dTmp(iseq,:)/sedDT - sedsto(iseq,:) = sedsto(iseq,:) - dTmp(iseq,:) - d2layer(iseq,:) = d2layer(iseq,:) + dTmp(iseq,:)/(1.d0-lambda) - endif - - d2netflw_avg(iseq,:) = d2netflw_avg(iseq,:) + d2netflw(iseq,:)*sedDT - enddo - !$omp end parallel do - end subroutine calc_entrainment + sedsto(iseq,:) = sedsto(iseq,:) + d2sedinp(iseq,:)*sedDT + IF ( sum(sedsto(iseq,:)) > P2RIVSTO(iseq,1) * 0.01d0 ) THEN + dTmp(iseq,:) = ( sum(sedsto(iseq,:)) - P2RIVSTO(iseq,1)*0.01d0 ) * sedsto(iseq,:)/sum(sedsto(iseq,:)) + d2netflw(iseq,:) = d2netflw(iseq,:) - dTmp(iseq,:)/sedDT + sedsto(iseq,:) = sedsto(iseq,:) - dTmp(iseq,:) + d2layer(iseq,:) = d2layer(iseq,:) + dTmp(iseq,:)/(1.d0-lambda) + ENDIF + + d2netflw_avg(iseq,:) = d2netflw_avg(iseq,:) + d2netflw(iseq,:)*sedDT + ENDDO +!$omp END parallel DO + END SUBROUTINE calc_entrainment !===================================================== - subroutine calc_exchange - ! redistribute into vertical bed layers - use yos_cmf_sed, only: d2seddep, lyrdph, totlyrnum - - implicit none - integer(kind=JPIM) :: ilyr, ised, iseq, jlyr, slyr - real(kind=JPRB) :: diff, lyrvol, layerP(nsed), seddepP(totlyrnum+1,nsed), tmp(nsed) + SUBROUTINE calc_exchange + ! redistribute into vertical bed layers + USE yos_cmf_sed, only: d2seddep, lyrdph, totlyrnum + + IMPLICIT NONE + integer(kind=JPIM) :: ilyr, ised, iseq, jlyr, slyr + real(kind=JPRB) :: diff, lyrvol, layerP(nsed), seddepP(totlyrnum+1,nsed), tmp(nsed) - do iseq = 1, NSEQALL - lyrvol = lyrdph * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) + DO iseq = 1, NSEQALL + lyrvol = lyrdph * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) - if ( minval(d2layer(iseq,:)) < 0.d0 ) d2layer(iseq,:) = max( d2layer(iseq,:), 0.d0 ) - if ( minval(d2seddep(iseq,:,:)) < 0.d0 ) d2seddep(iseq,:,:) = max( d2seddep(iseq,:,:), 0.d0 ) + IF ( minval(d2layer(iseq,:)) < 0.d0 ) d2layer(iseq,:) = max( d2layer(iseq,:), 0.d0 ) + IF ( minval(d2seddep(iseq,:,:)) < 0.d0 ) d2seddep(iseq,:,:) = max( d2seddep(iseq,:,:), 0.d0 ) - !---------------------------------------! - ! if bed storage less than layer volume ! - !---------------------------------------! - if ( sum(d2layer(iseq,:)) + sum(d2seddep(iseq,:,:)) <= lyrvol ) then - d2layer(iseq,:) = d2layer(iseq,:) + sum(d2seddep(iseq,:,:),dim=1) - d2seddep(iseq,:,:) = 0.d0 - cycle - endif + !---------------------------------------! + ! IF bed storage less than layer volume ! + !---------------------------------------! + IF ( sum(d2layer(iseq,:)) + sum(d2seddep(iseq,:,:)) <= lyrvol ) THEN + d2layer(iseq,:) = d2layer(iseq,:) + sum(d2seddep(iseq,:,:),dim=1) + d2seddep(iseq,:,:) = 0.d0 + CYCLE + ENDIF - !------------------------------------! - ! distribute into top exchange layer ! - !------------------------------------! - layerP(:) = d2layer(iseq,:) - if ( sum(layerP(:)) >= lyrvol ) then - d2layer(iseq,:) = layerP(:) * min( lyrvol/sum(layerP(:)), 1.d0 ) - layerP(:) = max( layerP(:) - d2layer(iseq,:), 0.d0 ) - slyr = 0 - else if ( sum(d2seddep(iseq,:,:)) > 0.d0 ) then - layerP(:) = 0.d0 - do ilyr = 1, totlyrnum - diff = lyrvol - sum(d2layer(iseq,:)) - if ( diff <= 0.d0 ) exit - if ( sum(d2seddep(iseq,ilyr,:)) <= diff ) then - d2layer(iseq,:) = d2layer(iseq,:) + d2seddep(iseq,ilyr,:) - d2seddep(iseq,ilyr,:) = 0.d0 - slyr = ilyr + 1 - else - tmp(:) = diff * d2seddep(iseq,ilyr,:) / sum(d2seddep(iseq,ilyr,:)) - d2layer(iseq,:) = d2layer(iseq,:) + tmp(:) - d2seddep(iseq,ilyr,:) = max( d2seddep(iseq,ilyr,:) - tmp(:), 0.d0 ) - slyr = ilyr - exit - endif - enddo - else - d2seddep(iseq,:,:) = 0.d0 - cycle - endif - if ( sum(d2seddep(iseq,:,:)) == 0.d0 ) cycle + !------------------------------------! + ! distribute into top exchange layer ! + !------------------------------------! + layerP(:) = d2layer(iseq,:) + IF ( sum(layerP(:)) >= lyrvol ) THEN + d2layer(iseq,:) = layerP(:) * min( lyrvol/sum(layerP(:)), 1.d0 ) + layerP(:) = max( layerP(:) - d2layer(iseq,:), 0.d0 ) + slyr = 0 + ELSE IF ( sum(d2seddep(iseq,:,:)) > 0.d0 ) THEN + layerP(:) = 0.d0 + DO ilyr = 1, totlyrnum + diff = lyrvol - sum(d2layer(iseq,:)) + IF ( diff <= 0.d0 ) EXIT + IF ( sum(d2seddep(iseq,ilyr,:)) <= diff ) THEN + d2layer(iseq,:) = d2layer(iseq,:) + d2seddep(iseq,ilyr,:) + d2seddep(iseq,ilyr,:) = 0.d0 + slyr = ilyr + 1 + ELSE + tmp(:) = diff * d2seddep(iseq,ilyr,:) / sum(d2seddep(iseq,ilyr,:)) + d2layer(iseq,:) = d2layer(iseq,:) + tmp(:) + d2seddep(iseq,ilyr,:) = max( d2seddep(iseq,ilyr,:) - tmp(:), 0.d0 ) + slyr = ilyr + EXIT + ENDIF + ENDDO + ELSE + d2seddep(iseq,:,:) = 0.d0 + CYCLE + ENDIF + IF ( sum(d2seddep(iseq,:,:)) == 0.d0 ) CYCLE - !-----------------------------------! - ! distribute remaining bedload into ! - ! vertical deposition layers ! - !-----------------------------------! - seddepP(1,:) = layerP(:) - seddepP(2:,:) = d2seddep(iseq,:,:) - d2seddep(iseq,:,:) = 0.d0 - do ilyr = 1, totlyrnum - 1 - if ( sum(d2seddep(iseq,ilyr,:)) == lyrvol ) cycle - do jlyr = slyr+1, totlyrnum + 1 - diff = lyrvol - sum(d2seddep(iseq,ilyr,:)) - if ( diff <= 0.d0 ) exit - if ( sum(seddepP(jlyr,:)) <= diff ) then - d2seddep(iseq,ilyr,:) = d2seddep(iseq,ilyr,:) + seddepP(jlyr,:) - seddepP(jlyr,:) = 0.d0 - else - tmp(:) = diff * seddepP(jlyr,:) / sum(seddepP(jlyr,:)) - d2seddep(iseq,ilyr,:) = d2seddep(iseq,ilyr,:) + tmp(:) - seddepP(jlyr,:) = max(seddepP(jlyr,:) - tmp(:), 0.d0) - exit - endif - enddo - enddo - - if ( sum(seddepP) > 0.d0 ) then - d2seddep(iseq,totlyrnum,:) = sum(seddepP, dim=1) - endif - enddo + !-----------------------------------! + ! distribute remaining bedload into ! + ! vertical deposition layers ! + !-----------------------------------! + seddepP(1,:) = layerP(:) + seddepP(2:,:) = d2seddep(iseq,:,:) + d2seddep(iseq,:,:) = 0.d0 + DO ilyr = 1, totlyrnum - 1 + IF ( sum(d2seddep(iseq,ilyr,:)) == lyrvol ) CYCLE + DO jlyr = slyr+1, totlyrnum + 1 + diff = lyrvol - sum(d2seddep(iseq,ilyr,:)) + IF ( diff <= 0.d0 ) EXIT + IF ( sum(seddepP(jlyr,:)) <= diff ) THEN + d2seddep(iseq,ilyr,:) = d2seddep(iseq,ilyr,:) + seddepP(jlyr,:) + seddepP(jlyr,:) = 0.d0 + ELSE + tmp(:) = diff * seddepP(jlyr,:) / sum(seddepP(jlyr,:)) + d2seddep(iseq,ilyr,:) = d2seddep(iseq,ilyr,:) + tmp(:) + seddepP(jlyr,:) = max(seddepP(jlyr,:) - tmp(:), 0.d0) + EXIT + ENDIF + ENDDO + ENDDO + + IF ( sum(seddepP) > 0.d0 ) THEN + d2seddep(iseq,totlyrnum,:) = sum(seddepP, dim=1) + ENDIF + ENDDO - end subroutine calc_exchange -end subroutine cmf_calc_sedflw -!#################################################################### + END SUBROUTINE calc_exchange + END SUBROUTINE cmf_calc_sedflw + !#################################################################### -end module cmf_calc_sedflw_mod +END MODULE cmf_calc_sedflw_mod diff --git a/CaMa/src/sediment/cmf_calc_sedpar_mod.F90 b/CaMa/src/sediment/cmf_calc_sedpar_mod.F90 index 4382a41b..d5cb26a0 100755 --- a/CaMa/src/sediment/cmf_calc_sedpar_mod.F90 +++ b/CaMa/src/sediment/cmf_calc_sedpar_mod.F90 @@ -1,107 +1,106 @@ -module cmf_calc_sedpar_mod +MODULE cmf_calc_sedpar_mod !========================================================== !* PURPOSE: parameters for sediment transport ! (C) M.Hatono (Hiroshima-U) May 2021 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== - use PARKIND1, only: JPIM, JPRB + USE PARKIND1, only: JPIM, JPRB -contains -!#################################################################### -! -- csVel -! -- sVel -! -- susVel -!#################################################################### -function calc_settingVelocity() result(setVel) - use YOS_CMF_INPUT, only: PGRV - use yos_cmf_sed, only: nsed, psedD, pset, pwatD, sDiam, visKin - implicit none - save - real(kind=JPRB) :: setVel(nsed) ! setting velocity [m/s] - real(kind=JPRB) :: sTmp(nsed) +CONTAINS + !#################################################################### + ! -- csVel + ! -- sVel + ! -- susVel + !#################################################################### + FUNCTION calc_settingVelocity() result(setVel) + USE YOS_CMF_INPUT, only: PGRV + USE yos_cmf_sed, only: nsed, psedD, pset, pwatD, sDiam, visKin + IMPLICIT NONE + SAVE + real(kind=JPRB) :: setVel(nsed) ! setting velocity [m/s] + real(kind=JPRB) :: sTmp(nsed) - sTmp(:) = 6.d0 * visKin / sDiam(:) - setVel(:) = pset * ( sqrt( 2.d0/3.d0*(psedD-pwatD)/pwatD*PGRV*sDiam(:) & - + sTmp(:)*sTmp(:) ) - sTmp(:) ) -end function calc_settingVelocity -!===================================================== + sTmp(:) = 6.d0 * visKin / sDiam(:) + setVel(:) = pset * ( sqrt( 2.d0/3.d0*(psedD-pwatD)/pwatD*PGRV*sDiam(:) & + + sTmp(:)*sTmp(:) ) - sTmp(:) ) + END FUNCTION calc_settingVelocity + !===================================================== -function calc_criticalShearVelocity(diam) result(csVel) - implicit none - save - real(kind=JPRB) :: csVel ! critical shear velocity[(cm/s)^2] - real(kind=JPRB), intent(in) :: diam ![m] - real(kind=JPRB) :: cA, cB - !======== - cB = 1.d0 - if ( diam >= 0.00303d0 ) then - cA = 80.9d0 - else if ( diam >= 0.00118d0 ) then - cA = 134.6d0 - cB = 31.d0 / 32.d0 - else if ( diam >= 0.000565d0 ) then - cA = 55.d0 - else if ( diam >= 0.000065d0 ) then - cA = 8.41d0 - cB = 11.d0 / 32.d0 - else - cA = 226.d0 - endif - - csVel = cA * ( diam*100.d0 ) ** cB - return -end function calc_criticalShearVelocity -!===================================================== + FUNCTION calc_criticalShearVelocity(diam) result(csVel) + IMPLICIT NONE + SAVE + real(kind=JPRB) :: csVel ! critical shear velocity[(cm/s)^2] + real(kind=JPRB), intent(in) :: diam ![m] + real(kind=JPRB) :: cA, cB + !======== + cB = 1.d0 + IF ( diam >= 0.00303d0 ) THEN + cA = 80.9d0 + ELSE IF ( diam >= 0.00118d0 ) THEN + cA = 134.6d0 + cB = 31.d0 / 32.d0 + ELSE IF ( diam >= 0.000565d0 ) THEN + cA = 55.d0 + ELSE IF ( diam >= 0.000065d0 ) THEN + cA = 8.41d0 + cB = 11.d0 / 32.d0 + ELSE + cA = 226.d0 + ENDIF + + csVel = cA * ( diam*100.d0 ) ** cB + RETURN + END FUNCTION calc_criticalShearVelocity + !===================================================== -function calc_shearVelocity(rivvel,rivdph) result(sVel) - use YOS_CMF_INPUT, only: PGRV, PMANRIV - implicit none - save - real(kind=JPRB) :: sVel ! shear velocity[m/s] - real(kind=JPRB), intent(in) :: rivvel, rivdph - !======== + FUNCTION calc_shearVelocity(rivvel,rivdph) result(sVel) + USE YOS_CMF_INPUT, only: PGRV, PMANRIV + IMPLICIT NONE + SAVE + real(kind=JPRB) :: sVel ! shear velocity[m/s] + real(kind=JPRB), intent(in) :: rivvel, rivdph + !======== - sVel = sqrt ( PGRV * PMANRIV**2.d0 * rivvel**2.d0 * rivdph**(-1.d0/3.d0) ) !bug fix 2022/11/22 - return -end function calc_shearVelocity -!===================================================== + sVel = sqrt ( PGRV * PMANRIV**2.d0 * rivvel**2.d0 * rivdph**(-1.d0/3.d0) ) !bug fix 2022/11/22 + RETURN + END FUNCTION calc_shearVelocity + !===================================================== -function calc_suspendVelocity(csVel,sVel,setVel) result(susVel) ! Uchida and Fukuoka (2019) Eq.44 - use yos_cmf_sed, only: lambda, nsed, vonKar - implicit none - save - real(kind=JPRB) :: susVel(nsed) ! suspend velocity [m/s] -!! real(kind=JPRB), intent(in) :: csVel(nsed), sVel, setVel(nsed) ! crit shear, shear velocity, setting velocity [m/s] - real(kind=JPRB), intent(in) :: csVel(:), sVel, setVel(:) ! crit shear, shear velocity, setting velocity [m/s] - integer(kind=JPIM) :: ised - real(kind=JPRB) :: alpha, a, cB, sTmp - !======== - - !--------------! - ! set constant ! - !--------------! - alpha = vonKar / 6.d0 - a = 0.08d0 - cB = 1.d0 - lambda + FUNCTION calc_suspendVelocity(csVel,sVel,setVel) result(susVel) ! Uchida and Fukuoka (2019) Eq.44 + USE yos_cmf_sed, only: lambda, nsed, vonKar + IMPLICIT NONE + SAVE + real(kind=JPRB) :: susVel(nsed) ! suspend velocity [m/s] + !! real(kind=JPRB), intent(in) :: csVel(nsed), sVel, setVel(nsed) ! crit shear, shear velocity, setting velocity [m/s] + real(kind=JPRB), intent(in) :: csVel(:), sVel, setVel(:) ! crit shear, shear velocity, setting velocity [m/s] + integer(kind=JPIM) :: ised + real(kind=JPRB) :: alpha, a, cB, sTmp + !======== + !--------------! + ! set constant ! + !--------------! + alpha = vonKar / 6.d0 + a = 0.08d0 + cB = 1.d0 - lambda - !-----------------------! - ! calc suspend velocity ! - !-----------------------! - susVel(:) = 0.d0 - do ised = 1, nsed - if ( csVel(ised) > sVel ) cycle - sTmp = setVel(ised) / alpha / sVel - susVel(ised) = max( setVel(ised) * cB / (1.d0+sTmp) * (1.d0-a*sTmp) / (1.d0+(1.d0-a)*sTmp), 0.d0 ) - enddo -end function calc_suspendVelocity + !-----------------------! + ! calc suspend velocity ! + !-----------------------! + susVel(:) = 0.d0 + DO ised = 1, nsed + IF ( csVel(ised) > sVel ) CYCLE + sTmp = setVel(ised) / alpha / sVel + susVel(ised) = max( setVel(ised) * cB / (1.d0+sTmp) * (1.d0-a*sTmp) / (1.d0+(1.d0-a)*sTmp), 0.d0 ) + ENDDO + END FUNCTION calc_suspendVelocity !#################################################################### -end module cmf_calc_sedpar_mod +END MODULE cmf_calc_sedpar_mod diff --git a/CaMa/src/sediment/cmf_ctrl_sed_mod.F90 b/CaMa/src/sediment/cmf_ctrl_sed_mod.F90 index 3b3d1ef8..b0cd89b8 100755 --- a/CaMa/src/sediment/cmf_ctrl_sed_mod.F90 +++ b/CaMa/src/sediment/cmf_ctrl_sed_mod.F90 @@ -1,10 +1,10 @@ -module CMF_CTRL_SED_MOD +MODULE CMF_CTRL_SED_MOD !========================================================== !* PURPOSE: physics for sediment transport ! (C) M.Hatono (Hiroshima-U) May 2021 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is @@ -12,208 +12,207 @@ module CMF_CTRL_SED_MOD ! See the License for the specific language governing permissions and limitations under the License. !========================================================== #ifdef UseMPI_CMF - use MPI + USE MPI #endif - use PARKIND1, only: JPIM, JPRB, JPRM - use YOS_CMF_INPUT, only: LOGNAM, NX, NY - use YOS_CMF_MAP, only: MPI_COMM_CAMA, NSEQALL, NSEQMAX, REGIONTHIS - use CMF_UTILS_MOD, only: INQUIRE_FID - use yos_cmf_sed, only: lyrdph, nsed, totlyrnum, sDiam - - implicit none - !*** namelist/sediment_map/ - character(len=256) :: crocdph - character(len=256) :: csedfrc - character(len=256) :: sedD - namelist/sediment_map/ crocdph,sedD,csedfrc -contains -!#################################################################### -! -- cmf_sed_nmlist -! -- cmf_sed_init -!#################################################################### -subroutine cmf_sed_nmlist - use yos_cmf_sed, only: lambda, psedD, pset, pwatD, sedDT, & - revEgia, visKin, vonKar - - implicit none - integer(kind=JPIM) :: nsetfile - - namelist/sediment_param/ lambda, lyrdph, nsed, sedDT, psedD, & - pset, pwatD, revEgia, totlyrnum, & - visKin, vonKar - - nsetfile = INQUIRE_FID() - open(nsetfile,file='input_sed.nam',status='OLD') - - lambda = 0.4d0 - lyrdph = 0.00005d0 - nsed = 3 - sedDT = 3600 - psedD = 2.65d0 - pset = 1.d0 - pwatD = 1.d0 - revEgia = .true. - totlyrnum = 5 - visKin = 1.d-6 - vonKar = 0.4d0 - - rewind(nsetfile) - read(nsetfile,nml=sediment_param) - !defaults - write(LOGNAM,*) 'nml sediment_param' - write(LOGNAM,*) 'lambda :', lambda - write(LOGNAM,*) 'lyrdph :', lyrdph - write(LOGNAM,*) 'sedDT :', sedDT - write(LOGNAM,*) 'psedD :', psedD - write(LOGNAM,*) 'pset :', pset - write(LOGNAM,*) 'pwatD :', pwatD - write(LOGNAM,*) 'revEgia :', revEgia - write(LOGNAM,*) 'totlyrnum :', totlyrnum - write(LOGNAM,*) 'visKin :', visKin - write(LOGNAM,*) 'vonKar :', vonKar - - rewind(nsetfile) - read(nsetfile,nml=sediment_map) - !defaults - write(LOGNAM,*) 'nml sediment_map' - write(LOGNAM,*) 'crocdph :', trim(crocdph) - write(LOGNAM,*) 'sDiam :', sedD - write(LOGNAM,*) 'csedfrc :', csedfrc - - close(nsetfile) -end subroutine cmf_sed_nmlist -!========================================================== -!+ -!========================================================== -subroutine cmf_sed_init - use YOS_CMF_INPUT, only: LOUTPUT - use cmf_ctrl_sedinp_mod, only: sediment_input_init - use cmf_ctrl_sedout_mod, only: sediment_output_init - use cmf_ctrl_sedrest_mod, only: sediment_restart_init - - implicit none - - call sediment_vars_init - - call sediment_map_init - - call sediment_input_init - - if ( LOUTPUT ) then - call sediment_output_init - endif - - call sediment_restart_init - -contains -!================================== - subroutine sediment_map_init - use YOS_CMF_INPUT, only: NLFP, PGRV - use CMF_UTILS_MOD, only: mapR2vecD - use yos_cmf_sed, only: d2sedfrc, psedD, pset, pwatD, setVel, visKin - use cmf_calc_sedpar_mod, only: calc_settingVelocity - use sed_utils_mod, only: splitchar - - implicit none - integer(kind=JPIM) :: i, ierr, ised, iseq, tmpnam - real(kind=JPRM) :: r2temp(NX,NY), sTmp1(nsed) - character(len=256) :: ctmp(20) - - !------------------------! - ! get sediment diameters ! - !------------------------! - ctmp(:) = '-999' - call splitchar(sedD,ctmp) - ised = 0 - allocate(sDiam(nsed)) - do i = 1, nsed - if ( ctmp(i) /= '-999' ) then - ised = ised + 1 - read(ctmp(i),*) sDiam(ised) - endif - enddo - if ( ised /= nsed ) then - write(LOGNAM,*) 'nsed and sedD do not match',ised,nsed - stop - endif - write(LOGNAM,*) ised,' grain sizes: ',sDiam(:) - - !----------------------------! - ! calculate setting velocity ! - !----------------------------! - allocate(setVel(nsed)) - setVel(:) = calc_settingVelocity() - - !-----------------------------! - ! read sediment fraction file ! - !-----------------------------! - allocate(d2sedfrc(NSEQMAX,nsed)) - if ( REGIONTHIS == 1 ) then - tmpnam = INQUIRE_FID() - open(tmpnam,file=csedfrc,form='unformatted',access='direct',recl=4*NX*NY) - endif - do ised = 1, nsed - if ( REGIONTHIS == 1 ) read(tmpnam,rec=ised) r2temp + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM, NX, NY + USE YOS_CMF_MAP, only: MPI_COMM_CAMA, NSEQALL, NSEQMAX, REGIONTHIS + USE CMF_UTILS_MOD, only: INQUIRE_FID + USE yos_cmf_sed, only: lyrdph, nsed, totlyrnum, sDiam + + IMPLICIT NONE + !*** namelist/sediment_map/ + character(len=256) :: crocdph + character(len=256) :: csedfrc + character(len=256) :: sedD + namelist/sediment_map/ crocdph,sedD,csedfrc +CONTAINS + !#################################################################### + ! -- cmf_sed_nmlist + ! -- cmf_sed_init + !#################################################################### + SUBROUTINE cmf_sed_nmlist + USE yos_cmf_sed, only: lambda, psedD, pset, pwatD, sedDT, & + revEgia, visKin, vonKar + + IMPLICIT NONE + integer(kind=JPIM) :: nsetfile + + namelist/sediment_param/ lambda, lyrdph, nsed, sedDT, psedD, & + pset, pwatD, revEgia, totlyrnum, & + visKin, vonKar + + nsetfile = INQUIRE_FID() + open(nsetfile,file='input_sed.nam',status='OLD') + + lambda = 0.4d0 + lyrdph = 0.00005d0 + nsed = 3 + sedDT = 3600 + psedD = 2.65d0 + pset = 1.d0 + pwatD = 1.d0 + revEgia = .true. + totlyrnum = 5 + visKin = 1.d-6 + vonKar = 0.4d0 + + rewind(nsetfile) + read(nsetfile,nml=sediment_param) + !defaults + write(LOGNAM,*) 'nml sediment_param' + write(LOGNAM,*) 'lambda :', lambda + write(LOGNAM,*) 'lyrdph :', lyrdph + write(LOGNAM,*) 'sedDT :', sedDT + write(LOGNAM,*) 'psedD :', psedD + write(LOGNAM,*) 'pset :', pset + write(LOGNAM,*) 'pwatD :', pwatD + write(LOGNAM,*) 'revEgia :', revEgia + write(LOGNAM,*) 'totlyrnum :', totlyrnum + write(LOGNAM,*) 'visKin :', visKin + write(LOGNAM,*) 'vonKar :', vonKar + + rewind(nsetfile) + read(nsetfile,nml=sediment_map) + !defaults + write(LOGNAM,*) 'nml sediment_map' + write(LOGNAM,*) 'crocdph :', trim(crocdph) + write(LOGNAM,*) 'sDiam :', sedD + write(LOGNAM,*) 'csedfrc :', csedfrc + + close(nsetfile) + END SUBROUTINE cmf_sed_nmlist + !========================================================== + !+ + !========================================================== + SUBROUTINE cmf_sed_init + USE YOS_CMF_INPUT, only: LOUTPUT + USE cmf_ctrl_sedinp_mod, only: sediment_input_init + USE cmf_ctrl_sedout_mod, only: sediment_output_init + USE cmf_ctrl_sedrest_mod, only: sediment_restart_init + + IMPLICIT NONE + + CALL sediment_vars_init + + CALL sediment_map_init + + CALL sediment_input_init + + IF ( LOUTPUT ) THEN + CALL sediment_output_init + ENDIF + + CALL sediment_restart_init + + CONTAINS + !================================== + SUBROUTINE sediment_map_init + USE YOS_CMF_INPUT, only: NLFP, PGRV + USE CMF_UTILS_MOD, only: mapR2vecD + USE yos_cmf_sed, only: d2sedfrc, psedD, pset, pwatD, setVel, visKin + USE cmf_calc_sedpar_mod, only: calc_settingVelocity + USE sed_utils_mod, only: splitchar + + IMPLICIT NONE + integer(kind=JPIM) :: i, ierr, ised, iseq, tmpnam + real(kind=JPRM) :: r2temp(NX,NY), sTmp1(nsed) + character(len=256) :: ctmp(20) + + !------------------------! + ! get sediment diameters ! + !------------------------! + ctmp(:) = '-999' + CALL splitchar(sedD,ctmp) + ised = 0 + allocate(sDiam(nsed)) + DO i = 1, nsed + IF ( ctmp(i) /= '-999' ) THEN + ised = ised + 1 + read(ctmp(i),*) sDiam(ised) + ENDIF + ENDDO + IF ( ised /= nsed ) THEN + write(LOGNAM,*) 'nsed and sedD DO not match',ised,nsed + STOP + ENDIF + write(LOGNAM,*) ised,' grain sizes: ',sDiam(:) + + !----------------------------! + ! calculate setting velocity ! + !----------------------------! + allocate(setVel(nsed)) + setVel(:) = calc_settingVelocity() + + !-----------------------------! + ! read sediment fraction file ! + !-----------------------------! + allocate(d2sedfrc(NSEQMAX,nsed)) + IF ( REGIONTHIS == 1 ) THEN + tmpnam = INQUIRE_FID() + open(tmpnam,file=csedfrc,form='unformatted',access='direct',recl=4*NX*NY) + ENDIF + DO ised = 1, nsed + IF ( REGIONTHIS == 1 ) read(tmpnam,rec=ised) r2temp #ifdef UseMPI_CMF - call MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) + CALL MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) #endif - call mapR2vecD(r2temp,d2sedfrc(:,ised)) - enddo - if ( REGIONTHIS == 1 ) close(tmpnam) - - ! adjust if any fractions are negative or if sum is not equal to 1 - if ( nsed == 1 ) then - d2sedfrc(:,:) = 1.d0 - else - !$omp parallel do - do iseq = 1, NSEQALL - if ( minval(d2sedfrc(iseq,:)) < 0.d0 .or. sum(d2sedfrc(iseq,:)) == 0.d0 ) then - d2sedfrc(iseq,:) = 1.d0 / dble(nsed) - else if ( sum(d2sedfrc(iseq,:)) /= 1.d0 ) then - d2sedfrc(iseq,:) = d2sedfrc(iseq,:) / sum(d2sedfrc(iseq,:)) - endif - enddo - !$omp end parallel do - endif - end subroutine sediment_map_init -!================================== - subroutine sediment_vars_init - use yos_cmf_sed, only: d2bedout, d2netflw, d2seddep, & - d2bedout_avg, d2netflw_avg, & - d2sedout, d2sedcon, d2sedinp, & - d2sedout_avg, d2sedinp_avg, d2layer, & - d2sedv, d2sedv_avg, d2depv, & - sedDT, step_sed - use YOS_CMF_INPUT, only: DT - implicit none - - if ( mod(sedDT,DT) /= 0 ) then - write(lognam,*) 'sedDT ',sedDT,'is not a multiple of DT',DT - stop - endif - step_sed = int(sedDT/DT) - - allocate(d2sedv(NSEQMAX,nsed,6)) - d2sedv(:,:,:) = 0._JPRB - d2sedout => d2sedv(:,:,1) - d2sedcon => d2sedv(:,:,2) - d2sedinp => d2sedv(:,:,3) - d2bedout => d2sedv(:,:,4) - d2netflw => d2sedv(:,:,5) - d2layer => d2sedv(:,:,6) - - allocate(d2depv(NSEQMAX,totlyrnum,nsed)) - d2depv(:,:,:) = 0._JPRB - d2seddep => d2depv - - allocate(d2sedv_avg(NSEQMAX,nsed,4)) - d2sedv_avg(:,:,:) = 0._JPRB - d2sedout_avg => d2sedv_avg(:,:,1) - d2sedinp_avg => d2sedv_avg(:,:,2) - d2bedout_avg => d2sedv_avg(:,:,3) - d2netflw_avg => d2sedv_avg(:,:,4) - end subroutine sediment_vars_init - -end subroutine cmf_sed_init + CALL mapR2vecD(r2temp,d2sedfrc(:,ised)) + ENDDO + IF ( REGIONTHIS == 1 ) close(tmpnam) + + ! adjust if any fractions are negative or if sum is not equal to 1 + IF ( nsed == 1 ) THEN + d2sedfrc(:,:) = 1.d0 + ELSE +!$omp parallel DO + DO iseq = 1, NSEQALL + IF ( minval(d2sedfrc(iseq,:)) < 0.d0 .or. sum(d2sedfrc(iseq,:)) == 0.d0 ) THEN + d2sedfrc(iseq,:) = 1.d0 / dble(nsed) + ELSE IF ( sum(d2sedfrc(iseq,:)) /= 1.d0 ) THEN + d2sedfrc(iseq,:) = d2sedfrc(iseq,:) / sum(d2sedfrc(iseq,:)) + ENDIF + ENDDO +!$omp END parallel do + ENDIF + END SUBROUTINE sediment_map_init + !================================== + SUBROUTINE sediment_vars_init + USE yos_cmf_sed, only: d2bedout, d2netflw, d2seddep, & + d2bedout_avg, d2netflw_avg, & + d2sedout, d2sedcon, d2sedinp, & + d2sedout_avg, d2sedinp_avg, d2layer, & + d2sedv, d2sedv_avg, d2depv, & + sedDT, step_sed + USE YOS_CMF_INPUT, only: DT + IMPLICIT NONE + + IF ( mod(sedDT,DT) /= 0 ) THEN + write(lognam,*) 'sedDT ',sedDT,'is not a multiple of DT',DT + STOP + ENDIF + step_sed = int(sedDT/DT) + + allocate(d2sedv(NSEQMAX,nsed,6)) + d2sedv(:,:,:) = 0._JPRB + d2sedout => d2sedv(:,:,1) + d2sedcon => d2sedv(:,:,2) + d2sedinp => d2sedv(:,:,3) + d2bedout => d2sedv(:,:,4) + d2netflw => d2sedv(:,:,5) + d2layer => d2sedv(:,:,6) + + allocate(d2depv(NSEQMAX,totlyrnum,nsed)) + d2depv(:,:,:) = 0._JPRB + d2seddep => d2depv + + allocate(d2sedv_avg(NSEQMAX,nsed,4)) + d2sedv_avg(:,:,:) = 0._JPRB + d2sedout_avg => d2sedv_avg(:,:,1) + d2sedinp_avg => d2sedv_avg(:,:,2) + d2bedout_avg => d2sedv_avg(:,:,3) + d2netflw_avg => d2sedv_avg(:,:,4) + END SUBROUTINE sediment_vars_init + END SUBROUTINE cmf_sed_init !#################################################################### -end module CMF_CTRL_SED_MOD +END MODULE CMF_CTRL_SED_MOD diff --git a/CaMa/src/sediment/cmf_ctrl_sedinp_mod.F90 b/CaMa/src/sediment/cmf_ctrl_sedinp_mod.F90 index 91fa1c4f..5f8f4b3c 100755 --- a/CaMa/src/sediment/cmf_ctrl_sedinp_mod.F90 +++ b/CaMa/src/sediment/cmf_ctrl_sedinp_mod.F90 @@ -1,4 +1,4 @@ -module cmf_ctrl_sedinp_mod +MODULE cmf_ctrl_sedinp_mod !========================================================== !* PURPOSE: Manage sediment input ! (C) M.Hatono (Hiroshima-U) Oct 2022 @@ -12,228 +12,228 @@ module cmf_ctrl_sedinp_mod ! See the License for the specific language governing permissions and limitations under the License. !========================================================== #ifdef UseMPI_CMF - use MPI + USE MPI #endif - use PARKIND1, only: JPIM, JPRB, JPRM - use YOS_CMF_INPUT, only: LOGNAM - use YOS_CMF_MAP, only: NSEQALL, NSEQMAX, D2GRAREA - use CMF_CTRL_FORCING_MOD, only: INPX, INPY, INPA - - implicit none - save - character(len=256) :: sedinput_dir, sedinput_pre, sedinput_suf - - real(kind=JPRB),allocatable :: d2slope(:,:) ! floodplain slope [deg] - integer(kind=JPIM) :: iseq - - real(kind=JPRB) :: dsylunit ! unit conversion for sediment [m3/km2] -> [m3/m2] - real(kind=JPRB) :: pyld, pyldc, pyldpc ! parameters for sediment erosion calculation - -contains -!#################################################################### -!-- sediment_input_init -!-- cmf_sed_forcing -!-- calc_sedyld -!-- sedinp_interp -!#################################################################### -subroutine sediment_input_init + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM + USE YOS_CMF_MAP, only: NSEQALL, NSEQMAX, D2GRAREA + USE CMF_CTRL_FORCING_MOD, only: INPX, INPY, INPA + + IMPLICIT NONE + SAVE + character(len=256) :: sedinput_dir, sedinput_pre, sedinput_suf + + real(kind=JPRB),allocatable :: d2slope(:,:) ! floodplain slope [deg] + integer(kind=JPIM) :: iseq + + real(kind=JPRB) :: dsylunit ! unit conversion for sediment [m3/km2] -> [m3/m2] + real(kind=JPRB) :: pyld, pyldc, pyldpc ! parameters for sediment erosion calculation + +CONTAINS + !#################################################################### + !-- sediment_input_init + !-- cmf_sed_forcing + !-- calc_sedyld + !-- sedinp_interp + !#################################################################### + SUBROUTINE sediment_input_init #ifdef UseMPI_CMF - use YOS_CMF_MAP, only: MPI_COMM_CAMA + USE YOS_CMF_MAP, only: MPI_COMM_CAMA #endif - use CMF_UTILS_MOD, only: INQUIRE_FID, mapR2vecD - - implicit none - save - character(len=256) :: cslope ! slope file - character(len=256) :: cinpmat_sed ! input matrix for sediment - - call read_sedinp_nmlist - - call read_slope -contains -!================================ - subroutine read_sedinp_nmlist - implicit none - integer(kind=JPIM) :: nsetfile - - namelist/sediment_input/ sedinput_dir, sedinput_pre, sedinput_suf, & - cslope, dsylunit, pyld, pyldc, pyldpc, & - cinpmat_sed - - nsetfile = INQUIRE_FID() - open(nsetfile,file='input_sed.nam',status='OLD') - - sedinput_dir='./' - sedinput_pre='./' - sedinput_suf='./' - cslope='./slope.bin' - dsylunit = 1.d-6 - pyld = 0.01d0 - pyldc = 2.d0 - pyldpc = 2.d0 - cinpmat_sed = './inpmat.bin' - - rewind(nsetfile) - read(nsetfile,nml=sediment_input) - !defaults - write(LOGNAM,*) 'nml sediment_input' - write(LOGNAM,*) 'cslope :', trim(cslope) - write(LOGNAM,*) 'dsylunit :', dsylunit - write(LOGNAM,*) 'pyld :', pyld - write(LOGNAM,*) 'pyldc :', pyldc - write(LOGNAM,*) 'pyldpc :', pyldpc - write(LOGNAM,*) 'cinpmat_sed:', trim(cinpmat_sed) - end subroutine - - subroutine read_slope - use YOS_CMF_INPUT, only: NX,NY, NLFP - use YOS_CMF_MAP, only: REGIONTHIS - - implicit none - integer :: ierr, tmpnam, i - real(kind=jprm) :: r2temp(nx,ny) - allocate(d2slope(NSEQMAX,NLFP)) - if ( REGIONTHIS == 1 ) then - tmpnam = INQUIRE_FID() - open(tmpnam,file=cslope,form='unformatted',access='direct',recl=4*NX*NY) - endif - do i = 1, NLFP - if ( REGIONTHIS == 1 ) read(tmpnam,rec=i) r2temp + USE CMF_UTILS_MOD, only: INQUIRE_FID, mapR2vecD + + IMPLICIT NONE + SAVE + character(len=256) :: cslope ! slope file + character(len=256) :: cinpmat_sed ! input matrix for sediment + + CALL read_sedinp_nmlist + + CALL read_slope + CONTAINS + !================================ + SUBROUTINE read_sedinp_nmlist + IMPLICIT NONE + integer(kind=JPIM) :: nsetfile + + namelist/sediment_input/ sedinput_dir, sedinput_pre, sedinput_suf, & + cslope, dsylunit, pyld, pyldc, pyldpc, & + cinpmat_sed + + nsetfile = INQUIRE_FID() + open(nsetfile,file='input_sed.nam',status='OLD') + + sedinput_dir='./' + sedinput_pre='./' + sedinput_suf='./' + cslope='./slope.bin' + dsylunit = 1.d-6 + pyld = 0.01d0 + pyldc = 2.d0 + pyldpc = 2.d0 + cinpmat_sed = './inpmat.bin' + + rewind(nsetfile) + read(nsetfile,nml=sediment_input) + !defaults + write(LOGNAM,*) 'nml sediment_input' + write(LOGNAM,*) 'cslope :', trim(cslope) + write(LOGNAM,*) 'dsylunit :', dsylunit + write(LOGNAM,*) 'pyld :', pyld + write(LOGNAM,*) 'pyldc :', pyldc + write(LOGNAM,*) 'pyldpc :', pyldpc + write(LOGNAM,*) 'cinpmat_sed:', trim(cinpmat_sed) + END SUBROUTINE + + SUBROUTINE read_slope + USE YOS_CMF_INPUT, only: NX,NY, NLFP + USE YOS_CMF_MAP, only: REGIONTHIS + + IMPLICIT NONE + integer :: ierr, tmpnam, i + real(kind=jprm) :: r2temp(nx,ny) + allocate(d2slope(NSEQMAX,NLFP)) + IF ( REGIONTHIS == 1 ) THEN + tmpnam = INQUIRE_FID() + open(tmpnam,file=cslope,form='unformatted',access='direct',recl=4*NX*NY) + ENDIF + DO i = 1, NLFP + IF ( REGIONTHIS == 1 ) read(tmpnam,rec=i) r2temp #ifdef UseMPI_CMF - call MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) + CALL MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) #endif - call mapR2vecD(r2temp,d2slope(:,i)) - enddo - if ( REGIONTHIS == 1 ) close(tmpnam) - end subroutine read_slope + CALL mapR2vecD(r2temp,d2slope(:,i)) + ENDDO + IF ( REGIONTHIS == 1 ) close(tmpnam) + END SUBROUTINE read_slope -end subroutine sediment_input_init -!========================================================== -!+ -!========================================================== -subroutine cmf_sed_forcing - ! read forcing from file - use YOS_CMF_INPUT, only: TMPNAM,NXIN,NYIN,DTIN - use YOS_CMF_TIME, only: IYYYY, IMM, IDD, IHOUR, IMIN - use CMF_UTILS_MOD, only: CONV_END,INQUIRE_FID - - implicit none - save - real(kind=JPRB) :: d2temp(nseqmax) - !* local variables - integer(kind=jpim) :: irecinp - integer(kind=jpim) :: isec - character(len=256) :: cifname !! input file - character(len=256) :: cdate !! - real(kind=jprm) :: r2tmp(nxin,nyin) + END SUBROUTINE sediment_input_init + !========================================================== + !+ + !========================================================== + SUBROUTINE cmf_sed_forcing + ! read forcing from file + USE YOS_CMF_INPUT, only: TMPNAM,NXIN,NYIN,DTIN + USE YOS_CMF_TIME, only: IYYYY, IMM, IDD, IHOUR, IMIN + USE CMF_UTILS_MOD, only: CONV_END,INQUIRE_FID - !*** 1. calculate irec for sub-daily precipitation - isec = ihour*60*60+imin*60 !! current second in a day - irecinp = int( isec/dtin ) +1 !! precipitation irec (sub-daily precipitation) - - !*** 2. set file name - write(cdate,'(i4.4,i2.2,i2.2)') iyyyy,imm,idd - cifname=trim(sedinput_dir)//'/'//trim(sedinput_pre)//trim(cdate)//trim(sedinput_suf) - write(LOGNAM,*) "cmf::sed_forcing_get_bin:",trim(cifname) - - !*** 3. open & read forcing data - tmpnam=inquire_fid() - open(tmpnam,file=cifname,form='unformatted',access='direct',recl=4*nxin*nyin) - read(tmpnam,rec=irecinp) r2tmp - close(tmpnam) - - !*** 5. conduct necessary conversion - call sedinp_interp(r2tmp,d2temp) ! interpolate forcing grid to model grid - call calc_sedyld(d2temp) ! calculate sediment yield into rivers -end subroutine cmf_sed_forcing -!========================================================== -!+ -!========================================================== -subroutine calc_sedyld(pbuffin) - use PARKIND1, only: JPIM, JPRB - use YOS_CMF_INPUT, only: DTIN - use yos_cmf_sed, only: d2sedinp, d2sedinp_avg, d2sedfrc - - implicit none - save - real(kind=JPRB), intent(in) :: pbuffin(:) - real(kind=JPRB) :: sbuff(NSEQMAX) + IMPLICIT NONE + SAVE + real(kind=JPRB) :: d2temp(nseqmax) + !* local variables + integer(kind=jpim) :: irecinp + integer(kind=jpim) :: isec + character(len=256) :: cifname !! input file + character(len=256) :: cdate !! + real(kind=jprm) :: r2tmp(nxin,nyin) + + !*** 1. calculate irec for sub-daily precipitation + isec = ihour*60*60+imin*60 !! current second in a day + irecinp = int( isec/dtin ) +1 !! precipitation irec (sub-daily precipitation) + + !*** 2. set file name + write(cdate,'(i4.4,i2.2,i2.2)') iyyyy,imm,idd + cifname=trim(sedinput_dir)//'/'//trim(sedinput_pre)//trim(cdate)//trim(sedinput_suf) + write(LOGNAM,*) "cmf::sed_forcing_get_bin:",trim(cifname) + + !*** 3. open & read forcing data + tmpnam=inquire_fid() + open(tmpnam,file=cifname,form='unformatted',access='direct',recl=4*nxin*nyin) + read(tmpnam,rec=irecinp) r2tmp + close(tmpnam) + + !*** 5. conduct necessary conversion + CALL sedinp_interp(r2tmp,d2temp) ! interpolate forcing grid to model grid + CALL calc_sedyld(d2temp) ! calculate sediment yield into rivers + END SUBROUTINE cmf_sed_forcing + !========================================================== + !+ + !========================================================== + SUBROUTINE calc_sedyld(pbuffin) + USE PARKIND1, only: JPIM, JPRB + USE YOS_CMF_INPUT, only: DTIN + USE yos_cmf_sed, only: d2sedinp, d2sedinp_avg, d2sedfrc + + IMPLICIT NONE + SAVE + real(kind=JPRB), intent(in) :: pbuffin(:) + real(kind=JPRB) :: sbuff(NSEQMAX) !================================================ - - call prcp_convert_sed(pbuffin, sbuff) ! convert precipitation to sediment yield based on Sunada&Hasegawa(1993) + + CALL prcp_convert_sed(pbuffin, sbuff) ! convert precipitation to sediment yield based on Sunada&Hasegawa(1993) - !$omp parallel do - do iseq = 1, NSEQALL - d2sedinp(iseq,:) = sbuff(iseq) * d2sedfrc(iseq,:) ! distribute sediment yield to proportionate to sediment grain fraction - d2sedinp_avg(iseq,:) = d2sedinp_avg(iseq,:) + d2sedinp(iseq,:) * DTIN - enddo - !$omp end parallel do - -contains -!============================= -!+ prcp_convert_sed -!============================= - subroutine prcp_convert_sed(pbuffin,pbuffout) - use YOS_CMF_DIAG, only: D2FLDFRC - use YOS_CMF_INPUT, only: NLFP - - implicit none - save - real(kind=JPRB), intent(in) :: pbuffin(:) !! kg/m2/s - real(kind=JPRB), intent(out) :: pbuffout(:) !! m3/s - integer(kind=JPIM) :: i, iseq - - !$omp parallel do - do iseq = 1, NSEQALL - pbuffout(iseq) = 0.d0 - if ( pbuffin(iseq) * 86400.d0 <= 10.d0 ) cycle - - do i = 1, NLFP - if ( D2FLDFRC(iseq,1) * NLFP > dble(i) ) cycle ! no erosion if submerged - pbuffout(iseq) = pbuffout(iseq) + pyld * (pbuffin(iseq)*3600.d0)**pyldpc * d2slope(iseq,i)**pyldc / 3600.d0 & - & * D2GRAREA(iseq,1) * min(dble(i)/dble(NLFP)-D2FLDFRC(iseq,1), 1.d0/dble(NLFP)) * dsylunit - enddo - enddo - !$omp end parallel do - end subroutine prcp_convert_sed + !$omp parallel DO + DO iseq = 1, NSEQALL + d2sedinp(iseq,:) = sbuff(iseq) * d2sedfrc(iseq,:) ! distribute sediment yield to proportionate to sediment grain fraction + d2sedinp_avg(iseq,:) = d2sedinp_avg(iseq,:) + d2sedinp(iseq,:) * DTIN + ENDDO + !$omp end parallel DO + + CONTAINS + !============================= + !+ prcp_convert_sed + !============================= + SUBROUTINE prcp_convert_sed(pbuffin,pbuffout) + USE YOS_CMF_DIAG, only: D2FLDFRC + USE YOS_CMF_INPUT, only: NLFP + + IMPLICIT NONE + SAVE + real(kind=JPRB), intent(in) :: pbuffin(:) !! kg/m2/s + real(kind=JPRB), intent(out) :: pbuffout(:) !! m3/s + integer(kind=JPIM) :: i, iseq + +!$omp parallel DO + DO iseq = 1, NSEQALL + pbuffout(iseq) = 0.d0 + IF ( pbuffin(iseq) * 86400.d0 <= 10.d0 ) CYCLE + + DO i = 1, NLFP + IF ( D2FLDFRC(iseq,1) * NLFP > dble(i) ) CYCLE ! no erosion if submerged + pbuffout(iseq) = pbuffout(iseq) + pyld * (pbuffin(iseq)*3600.d0)**pyldpc * d2slope(iseq,i)**pyldc / 3600.d0 & + & * D2GRAREA(iseq,1) * min(dble(i)/dble(NLFP)-D2FLDFRC(iseq,1), 1.d0/dble(NLFP)) * dsylunit + ENDDO + ENDDO +!$omp end parallel do + END SUBROUTINE prcp_convert_sed -end subroutine calc_sedyld -!========================================================== -!+ -!========================================================== -subroutine sedinp_interp(pbuffin,pbuffout) -! interporlate sediment forcing data using "input matrix" - use YOS_CMF_INPUT, only: NXIN, NYIN, INPN, RMIS + END SUBROUTINE calc_sedyld + !========================================================== + !+ + !========================================================== + SUBROUTINE sedinp_interp(pbuffin,pbuffout) + ! interporlate sediment forcing data using "input matrix" + USE YOS_CMF_INPUT, only: NXIN, NYIN, INPN, RMIS - implicit none - real(kind=JPRM),intent(in) :: pbuffin(:,:) !! default for prcp[kg/m2/s] - real(kind=JPRB),intent(out) :: pbuffout(:) !! kg/m2/s - ! save for omp - integer(kind=jpim),save :: iseq, ixin, iyin, inpi !! for output - !$omp threadprivate (ixin, iyin) + IMPLICIT NONE + real(kind=JPRM),intent(in) :: pbuffin(:,:) !! default for prcp[kg/m2/s] + real(kind=JPRB),intent(out) :: pbuffout(:) !! kg/m2/s + ! save for omp + integer(kind=jpim),SAVE :: iseq, ixin, iyin, inpi !! for output +!$omp threadprivate (ixin, iyin) !============================ - !$omp parallel do - do iseq=1, NSEQALL - pbuffout(iseq)=0._JPRB - do inpi=1, INPN - ixin=INPX(iseq,inpi) - iyin=INPY(iseq,inpi) - if( ixin>0 )then - if( ixin > NXIN .or. iyin > NYIN ) then - write(LOGNAM,*) "error" - write(LOGNAM,*) 'xxx',iseq,inpi,ixin,iyin - cycle - endif - if( pbuffin(ixin,iyin).ne.RMIS )then - pbuffout(iseq) = pbuffout(iseq) + pbuffin(ixin,iyin) * INPA(iseq,inpi) / D2GRAREA(iseq,1) - endif - endif - end do - pbuffout(iseq)=max(pbuffout(iseq), 0._JPRB) - end do - !$omp end parallel do -end subroutine sedinp_interp +!$omp parallel do + DO iseq=1, NSEQALL + pbuffout(iseq)=0._JPRB + DO inpi=1, INPN + ixin=INPX(iseq,inpi) + iyin=INPY(iseq,inpi) + IF( ixin>0 )THEN + IF( ixin > NXIN .or. iyin > NYIN ) THEN + write(LOGNAM,*) "error" + write(LOGNAM,*) 'xxx',iseq,inpi,ixin,iyin + CYCLE + ENDIF + IF( pbuffin(ixin,iyin).ne.RMIS )THEN + pbuffout(iseq) = pbuffout(iseq) + pbuffin(ixin,iyin) * INPA(iseq,inpi) / D2GRAREA(iseq,1) + ENDIF + ENDIF + ENDDO + pbuffout(iseq)=max(pbuffout(iseq), 0._JPRB) + ENDDO +!$omp END parallel do + END SUBROUTINE sedinp_interp !#################################################################### -end module cmf_ctrl_sedinp_mod +END MODULE cmf_ctrl_sedinp_mod diff --git a/CaMa/src/sediment/cmf_ctrl_sedout_mod.F90 b/CaMa/src/sediment/cmf_ctrl_sedout_mod.F90 index e8213189..36cc4d07 100755 --- a/CaMa/src/sediment/cmf_ctrl_sedout_mod.F90 +++ b/CaMa/src/sediment/cmf_ctrl_sedout_mod.F90 @@ -1,392 +1,391 @@ -module cmf_ctrl_sedout_mod +MODULE cmf_ctrl_sedout_mod !========================================================== -!* PURPOSE: Output module for CaMa-Flood sediment scheme +!* PURPOSE: Output MODULE for CaMa-Flood sediment scheme ! (C) M. Hatono (Hiroshima Univ) Jan 2023 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== - use PARKIND1, only: JPIM, JPRB, JPRM - use YOS_CMF_INPUT, only: LOGNAM, NX, NY - use YOS_CMF_MAP, only: REGIONTHIS - use CMF_CTRL_OUTPUT_MOD, only: COUTDIR, IRECOUT, LOUTCDF, LOUTVEC, TVAROUT - use yos_cmf_sed, only: nsed + USE PARKIND1, only: JPIM, JPRB, JPRM + USE YOS_CMF_INPUT, only: LOGNAM, NX, NY + USE YOS_CMF_MAP, only: REGIONTHIS + USE CMF_CTRL_OUTPUT_MOD, only: COUTDIR, IRECOUT, LOUTCDF, LOUTVEC, TVAROUT + USE yos_cmf_sed, only: nsed - implicit none - save - type(TVAROUT),allocatable :: varout(:) ! output variable type set + IMPLICIT NONE + SAVE + type(TVAROUT),allocatable :: varout(:) ! output variable type set - integer(kind=JPIM) :: nvarsout + integer(kind=JPIM) :: nvarsout - !*** namelist/sediment_output - character(len=256) :: csedsout - namelist/sediment_output/ csedsout + !*** namelist/sediment_output + character(len=256) :: csedsout + namelist/sediment_output/ csedsout -contains -!#################################################################### -!-- sediment_output_init -!-- cmf_sed_output -!-- sediment_output_end -!#################################################################### -subroutine sediment_output_init - use CMF_CTRL_OUTPUT_MOD, only: COUTTAG - use CMF_UTILS_MOD, only: INQUIRE_FID - use sed_utils_mod, only: splitchar - - implicit none - save - integer(kind=JPIM) :: jf, j - integer(kind=JPIM) :: nvars, nsetfile - parameter (nvars=30) - character(len=256) :: cvnames(nvars), fName - - nsetfile = INQUIRE_FID() - open(nsetfile,file='input_sed.nam',status='OLD') - rewind(nsetfile) - read(nsetfile,nml=sediment_output) - close(nsetfile) - - !---------------------------! - ! get output variable names ! - !---------------------------! - cvnames(:) = 'none' - nvarsout = 0 - call splitchar(csedsout,cvnames) - do j = 1, nvars - if ( cvnames(j) /= 'none' ) then - nvarsout = nvarsout + 1 - endif - enddo +CONTAINS + !#################################################################### + !-- sediment_output_init + !-- cmf_sed_output + !-- sediment_output_end + !#################################################################### + SUBROUTINE sediment_output_init + USE CMF_CTRL_OUTPUT_MOD, only: COUTTAG + USE CMF_UTILS_MOD, only: INQUIRE_FID + USE sed_utils_mod, only: splitchar + + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: jf, j + integer(kind=JPIM) :: nvars, nsetfile + parameter (nvars=30) + character(len=256) :: cvnames(nvars), fName + + nsetfile = INQUIRE_FID() + open(nsetfile,file='input_sed.nam',status='OLD') + rewind(nsetfile) + read(nsetfile,nml=sediment_output) + close(nsetfile) - if ( nvarsout == 0 ) then - write(LOGNAM,*) "cmf::sed_output_init: no output files will be produced!" - return - endif + !---------------------------! + ! get output variable names ! + !---------------------------! + cvnames(:) = 'NONE' + nvarsout = 0 + CALL splitchar(csedsout,cvnames) + DO j = 1, nvars + IF ( cvnames(j) /= 'NONE' ) THEN + nvarsout = nvarsout + 1 + ENDIF + ENDDO - allocate(varout(nvarsout)) + IF ( nvarsout == 0 ) THEN + write(LOGNAM,*) "cmf::sed_output_init: no output files will be produced!" + RETURN + ENDIF - !* loop on variables and create files - do jf=1,nvarsout - write(LOGNAM,*) "creating output for variable:", trim( cvnames(jf) ) - select case (cvnames(jf)) - case ('sedout') - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='suspended sediment flow' - varout(jf)%cvunits='m3/s' - case ('sedcon') - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='suspended sediment concentration' - varout(jf)%cvunits='m3/m3' - case ('sedinp') - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='sediment inflow from land' - varout(jf)%cvunits='m3/s' - case ('bedout') - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='bedload' - varout(jf)%cvunits='m3/s' - case ('netflw') - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='net entrainment flow' - varout(jf)%cvunits='m3/s' - case ('layer') - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='exchange layer volume' - varout(jf)%cvunits='m3' - case default ! should only be seddep - if ( cvnames(jf)(:6) == 'deplyr' ) then - varout(jf)%cvname=cvnames(jf) - varout(jf)%cvlname='river bed volume (vertical layer)' - varout(jf)%cvunits='m3' - else - write(LOGNAM,*) trim(cvnames(jf)), 'Not defined in sediment output init' - endif - end select - varout(jf)%binid=INQUIRE_FID() + allocate(varout(nvarsout)) - if ( trim(varout(jf)%cvname(:6)) == 'deplyr' ) then - fName = trim(varout(jf)%cvname)//'_'//trim(COUTTAG) - else - fName = trim(varout(jf)%cvname)//trim(COUTTAG) - endif + !* loop on variables and create files + DO jf=1,nvarsout + write(LOGNAM,*) "creating output for variable:", trim( cvnames(jf) ) + select CASE (cvnames(jf)) + CASE ('sedout') + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='suspended sediment flow' + varout(jf)%cvunits='m3/s' + CASE ('sedcon') + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='suspended sediment concentration' + varout(jf)%cvunits='m3/m3' + CASE ('sedinp') + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='sediment inflow from land' + varout(jf)%cvunits='m3/s' + CASE ('bedout') + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='bedload' + varout(jf)%cvunits='m3/s' + CASE ('netflw') + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='net entrainment flow' + varout(jf)%cvunits='m3/s' + CASE ('layer') + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='exchange layer volume' + varout(jf)%cvunits='m3' + CASE default ! should only be seddep + IF ( cvnames(jf)(:6) == 'deplyr' ) THEN + varout(jf)%cvname=cvnames(jf) + varout(jf)%cvlname='river bed volume (vertical layer)' + varout(jf)%cvunits='m3' + ELSE + write(LOGNAM,*) trim(cvnames(jf)), 'Not defined in sediment output init' + ENDIF + END select + varout(jf)%binid=INQUIRE_FID() - if ( LOUTCDF ) then - if ( REGIONTHIS==1 ) then - call create_outcdf - endif - else - call create_outbin - endif - enddo + IF ( trim(varout(jf)%cvname(:6)) == 'deplyr' ) THEN + fName = trim(varout(jf)%cvname)//'_'//trim(COUTTAG) + ELSE + fName = trim(varout(jf)%cvname)//trim(COUTTAG) + ENDIF -contains + IF ( LOUTCDF ) THEN + IF ( REGIONTHIS==1 ) THEN + CALL create_outcdf + ENDIF + ELSE + CALL create_outbin + ENDIF + ENDDO - subroutine create_outcdf + CONTAINS + SUBROUTINE create_outcdf #ifdef UseCDF_CMF - use YOS_CMF_INPUT, only: RMIS, CSUFCDF - use YOS_CMF_TIME, only: ISYYYY, ISMM, ISDD, ISHOUR, ISMIN - use YOS_CMF_MAP, only: D1LON, D1LAT - use CMF_UTILS_MOD, only: NCERROR - use CMF_CTRL_OUTPUT_MOD, only: NDLEVEL - use yos_cmf_sed, only: sDiam - use NETCDF + USE YOS_CMF_INPUT, only: RMIS, CSUFCDF + USE YOS_CMF_TIME, only: ISYYYY, ISMM, ISDD, ISHOUR, ISMIN + USE YOS_CMF_MAP, only: D1LON, D1LAT + USE CMF_UTILS_MOD, only: NCERROR + USE CMF_CTRL_OUTPUT_MOD, only: NDLEVEL + USE yos_cmf_sed, only: sDiam + USE NETCDF - implicit none - save - integer(kind=JPIM) :: timeid, varid, latid, lonid, sedid - character(len=256) :: ctime + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: timeid, varid, latid, lonid, sedid + character(len=256) :: ctime - varout(jf)%irecnc = 1 + varout(jf)%irecnc = 1 - varout(jf)%cfile = trim(COUTDIR)//trim(fName)//trim(CSUFCDF) - call NCERROR( nf90_create(varout(jf)%cfile,nf90_netcdf4,varout(jf)%ncid),& - 'creating file:'//trim(varout(jf)%cfile) ) - !=== set dimension === - call NCERROR( nf90_def_dim(varout(jf)%ncid, 'time', nf90_unlimited, timeid) ) - call NCERROR( nf90_def_dim(varout(jf)%ncid, 'lat', NY, latid) ) - call NCERROR( nf90_def_dim(varout(jf)%ncid, 'lon', NX, lonid) ) - call NCERROR( nf90_def_dim(varout(jf)%ncid, 'sedD', nsed, sedid) ) - - !=== define variables === - call NCERROR( nf90_def_var(varout(jf)%ncid, 'sedD', nf90_double, (/sedid/), varid) ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'long_name','sediment grain size') ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'units','meters') ) - - call NCERROR( nf90_def_var(varout(jf)%ncid, 'lat', nf90_float, (/latid/), varid) ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'long_name','latitude') ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'units','degrees_north') ) - - call NCERROR( nf90_def_var(varout(jf)%ncid, 'lon', nf90_float, (/lonid/), varid) ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'long_name','longitude') ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'units','degrees_east') ) + varout(jf)%cfile = trim(COUTDIR)//trim(fName)//trim(CSUFCDF) + CALL NCERROR( nf90_create(varout(jf)%cfile,nf90_netcdf4,varout(jf)%ncid),& + 'creating file:'//trim(varout(jf)%cfile) ) + !=== set dimension === + CALL NCERROR( nf90_def_dim(varout(jf)%ncid, 'time', nf90_unlimited, timeid) ) + CALL NCERROR( nf90_def_dim(varout(jf)%ncid, 'lat', NY, latid) ) + CALL NCERROR( nf90_def_dim(varout(jf)%ncid, 'lon', NX, lonid) ) + CALL NCERROR( nf90_def_dim(varout(jf)%ncid, 'sedD', nsed, sedid) ) - write(ctime,'(a14,i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2)') 'seconds since ',ISYYYY,'-',ISMM,'-',ISDD,' ',ISHOUR,":",ISMIN - call NCERROR( nf90_def_var(varout(jf)%ncid, 'time', nf90_double, (/timeid/), varout(jf)%timid) ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%timid, 'long_name','time') ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%timid, 'units',ctime) ) - - !=== - call NCERROR( nf90_def_var(varout(jf)%ncid, varout(jf)%cvname, nf90_float, & - (/lonid,latid,sedid,timeid/), varout(jf)%varid,deflate_level=ndlevel), & - 'creating variable') - - call NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%varid, 'long_name', trim(varout(jf)%cvlname)) ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%varid, 'units', trim(varout(jf)%cvunits)) ) - call NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%varid, '_fillvalue',rmis) ) - - call NCERROR( nf90_enddef(varout(jf)%ncid) ) - - !=== put nsed lon lat info === - call NCERROR ( nf90_inq_varid(varout(jf)%ncid,'sedD',varid),'getting id' ) - call NCERROR( nf90_put_var(varout(jf)%ncid,varid,sDiam)) + !=== define variables === + CALL NCERROR( nf90_def_var(varout(jf)%ncid, 'sedD', nf90_double, (/sedid/), varid) ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'long_name','sediment grain size') ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'units','meters') ) - call NCERROR ( nf90_inq_varid(varout(jf)%ncid,'lon',varid),'getting id' ) - call NCERROR( nf90_put_var(varout(jf)%ncid,varid,D1LON)) - - call NCERROR ( nf90_inq_varid(varout(jf)%ncid,'lat',varid),'getting id' ) - call NCERROR( nf90_put_var(varout(jf)%ncid,varid,D1LAT)) - - write(LOGNAM,*) 'cfile: ',trim(varout(jf)%cfile),' cvar:',trim(varout(jf)%cvname),& - ' clname: ',trim(varout(jf)%cvlname),' cunits: ',trim(varout(jf)%cvunits) - write(LOGNAM,*) 'open in unit: ',varout(jf)%ncid + CALL NCERROR( nf90_def_var(varout(jf)%ncid, 'lat', nf90_float, (/latid/), varid) ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'long_name','latitude') ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'units','degrees_north') ) + + CALL NCERROR( nf90_def_var(varout(jf)%ncid, 'lon', nf90_float, (/lonid/), varid) ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'long_name','longitude') ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varid, 'units','degrees_east') ) + + write(ctime,'(a14,i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2)') 'seconds since ',ISYYYY,'-',ISMM,'-',ISDD,' ',ISHOUR,":",ISMIN + CALL NCERROR( nf90_def_var(varout(jf)%ncid, 'time', nf90_double, (/timeid/), varout(jf)%timid) ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%timid, 'long_name','time') ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%timid, 'units',ctime) ) + + !=== + CALL NCERROR( nf90_def_var(varout(jf)%ncid, varout(jf)%cvname, nf90_float, & + (/lonid,latid,sedid,timeid/), varout(jf)%varid,deflate_level=ndlevel), & + 'creating variable') + + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%varid, 'long_name', trim(varout(jf)%cvlname)) ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%varid, 'units', trim(varout(jf)%cvunits)) ) + CALL NCERROR( nf90_put_att(varout(jf)%ncid, varout(jf)%varid, '_fillvalue',rmis) ) + + CALL NCERROR( nf90_enddef(varout(jf)%ncid) ) + + !=== put nsed lon lat info === + CALL NCERROR ( nf90_inq_varid(varout(jf)%ncid,'sedD',varid),'getting id' ) + CALL NCERROR( nf90_put_var(varout(jf)%ncid,varid,sDiam)) + + CALL NCERROR ( nf90_inq_varid(varout(jf)%ncid,'lon',varid),'getting id' ) + CALL NCERROR( nf90_put_var(varout(jf)%ncid,varid,D1LON)) + + CALL NCERROR ( nf90_inq_varid(varout(jf)%ncid,'lat',varid),'getting id' ) + CALL NCERROR( nf90_put_var(varout(jf)%ncid,varid,D1LAT)) + + write(LOGNAM,*) 'cfile: ',trim(varout(jf)%cfile),' cvar:',trim(varout(jf)%cvname),& + ' clname: ',trim(varout(jf)%cvlname),' cunits: ',trim(varout(jf)%cvunits) + write(LOGNAM,*) 'open in unit: ',varout(jf)%ncid #endif - end subroutine create_outcdf + END SUBROUTINE create_outcdf - subroutine create_outbin - use YOS_CMF_INPUT, only: CSUFBIN, CSUFVEC - use YOS_CMF_MAP, only: NSEQMAX, REGIONALL - - implicit none - - if ( LOUTVEC ) then - varout(jf)%cfile=trim(coutdir)//trim(fName)//trim(CSUFVEC) - open(varout(jf)%binid,file=varout(jf)%cfile,form='unformatted',access='direct',recl=4*NSEQMAX*nsed) - else - if ( REGIONTHIS==1 ) then - varout(jf)%cfile=trim(coutdir)//trim(fName)//trim(CSUFBIN) - open(varout(jf)%binid,file=varout(jf)%cfile,form='unformatted',access='direct',recl=4*NX*NY*nsed) - endif - endif - write(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID - end subroutine create_outbin + SUBROUTINE create_outbin + USE YOS_CMF_INPUT, only: CSUFBIN, CSUFVEC + USE YOS_CMF_MAP, only: NSEQMAX, REGIONALL + + IMPLICIT NONE + + IF ( LOUTVEC ) THEN + varout(jf)%cfile=trim(coutdir)//trim(fName)//trim(CSUFVEC) + open(varout(jf)%binid,file=varout(jf)%cfile,form='unformatted',access='direct',recl=4*NSEQMAX*nsed) + ELSE + IF ( REGIONTHIS==1 ) THEN + varout(jf)%cfile=trim(coutdir)//trim(fName)//trim(CSUFBIN) + open(varout(jf)%binid,file=varout(jf)%cfile,form='unformatted',access='direct',recl=4*NX*NY*nsed) + ENDIF + ENDIF + write(LOGNAM,*) "output file opened in unit: ", TRIM(VAROUT(JF)%CFILE), VAROUT(JF)%BINID + END SUBROUTINE create_outbin -end subroutine sediment_output_init -!========================================================== -!+ -!========================================================== -subroutine cmf_sed_output - use CMF_UTILS_MOD, only: vecD2mapR - use YOS_CMF_INPUT, only: IFRQ_OUT, RMIS - use YOS_CMF_MAP, only: NSEQMAX - use YOS_CMF_TIME, only: JHOUR, JMIN - use yos_cmf_sed, only: d2layer, d2sedcon, d2seddep, d2bedout_avg, d2netflw_avg, & - d2sedout_avg, d2sedinp_avg, d2sedv_avg, sadd_out - use cmf_ctrl_sedrest_mod, only: sediment_restart_write + END SUBROUTINE sediment_output_init + !========================================================== + !+ + !========================================================== + SUBROUTINE cmf_sed_output + USE CMF_UTILS_MOD, only: vecD2mapR + USE YOS_CMF_INPUT, only: IFRQ_OUT, RMIS + USE YOS_CMF_MAP, only: NSEQMAX + USE YOS_CMF_TIME, only: JHOUR, JMIN + USE yos_cmf_sed, only: d2layer, d2sedcon, d2seddep, d2bedout_avg, d2netflw_avg, & + d2sedout_avg, d2sedinp_avg, d2sedv_avg, sadd_out + USE cmf_ctrl_sedrest_mod, only: sediment_restart_write #ifdef UseMPI_CMF - use CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R2MAP + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R2MAP #endif - implicit none - save - integer(kind=JPIM) :: ilyr, ised - integer(kind=JPIM) :: jf - real(kind=JPRB),pointer :: d2vec(:,:) ! point data location to output - !*** local - real(kind=JPRM) :: r3out(NX,NY,nsed) - !================================================ - call sediment_restart_write + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: ilyr, ised + integer(kind=JPIM) :: jf + real(kind=JPRB),pointer :: d2vec(:,:) ! point data location to output + !*** local + real(kind=JPRM) :: r3out(NX,NY,nsed) + !================================================ + CALL sediment_restart_write - d2sedv_avg(:,:,:) = d2sedv_avg(:,:,:) / dble(sadd_out) - write(LOGNAM,*) 'cmf_sed_output: average ',sadd_out,' seconds' + d2sedv_avg(:,:,:) = d2sedv_avg(:,:,:) / dble(sadd_out) + write(LOGNAM,*) 'cmf_sed_output: average ',sadd_out,' seconds' - !*** 0. check date:hour with output frequency - if ( mod(JHOUR,IFRQ_OUT)==0 .and. JMIN==0 ) then ! JHOUR: end of time step , nfpph: output frequency (hour) + !*** 0. check date:hour with output frequency + IF ( mod(JHOUR,IFRQ_OUT)==0 .and. JMIN==0 ) THEN ! JHOUR: END of time step , nfpph: output frequency (hour) - !*** 1. calc average variable - write(LOGNAM,*) 'cmf::sediment_output_write: write irec: ', IRECOUT + !*** 1. calc average variable + write(LOGNAM,*) 'cmf::sediment_output_write: write irec: ', IRECOUT - !*** 2. check variable name & allocate data to pointer dvec - do jf=1,nvarsout - select case (varout(jf)%cvname) - case ('sedout') - d2vec => d2sedout_avg - case ('sedcon') - d2vec => d2sedcon - case ('sedinp') - d2vec => d2sedinp_avg - case ('bedout') - d2vec => d2bedout_avg - case ('netflw') - d2vec => d2netflw_avg - case ('layer') - d2vec => d2layer - case default - if ( varout(jf)%cvname(:6) == 'deplyr' ) then - read(varout(jf)%cvname(7:8),*) ilyr - d2vec => d2seddep(:,ilyr,:) - else - write(LOGNAM,*) varout(jf)%cvname, ' not defined in cmf_output_mod' - endif - end select !! variable name select + !*** 2. check variable name & allocate data to pointer dvec + DO jf=1,nvarsout + select CASE (varout(jf)%cvname) + CASE ('sedout') + d2vec => d2sedout_avg + CASE ('sedcon') + d2vec => d2sedcon + CASE ('sedinp') + d2vec => d2sedinp_avg + CASE ('bedout') + d2vec => d2bedout_avg + CASE ('netflw') + d2vec => d2netflw_avg + CASE ('layer') + d2vec => d2layer + CASE default + IF ( varout(jf)%cvname(:6) == 'deplyr' ) THEN + read(varout(jf)%cvname(7:8),*) ilyr + d2vec => d2seddep(:,ilyr,:) + ELSE + write(LOGNAM,*) varout(jf)%cvname, ' not defined in cmf_output_mod' + ENDIF + END select !! variable name select - !! convert 1dvector to 3dmap - r3out(:,:,:) = RMIS - - if ( .not. LOUTVEC ) then - do ised = 1, nsed - call vecD2mapR(d2vec(:,ised),r3out(:,:,ised)) !! mpi node data is gathered by vec2map + !! convert 1dvector to 3dmap + r3out(:,:,:) = RMIS + + IF ( .not. LOUTVEC ) THEN + DO ised = 1, nsed + CALL vecD2mapR(d2vec(:,ised),r3out(:,:,ised)) !! mpi node data is gathered by vec2map #ifdef UseMPI_CMF - call CMF_MPI_AllReduce_R2MAP(r3out(:,:,ised)) + CALL CMF_MPI_AllReduce_R2MAP(r3out(:,:,ised)) #endif - enddo + ENDDO - if ( REGIONTHIS==1 ) then - if ( LOUTCDF ) then - call wrte_outcdf - else - call wrte_outbin(varout(jf)%binid,IRECOUT,r3out) - endif - endif - else - call wrte_outvec(varout(jf)%binid,IRECOUT,d2vec) - endif - end do + IF ( REGIONTHIS==1 ) THEN + IF ( LOUTCDF ) THEN + CALL wrte_outcdf + ELSE + CALL wrte_outbin(varout(jf)%binid,IRECOUT,r3out) + ENDIF + ENDIF + ELSE + CALL wrte_outvec(varout(jf)%binid,IRECOUT,d2vec) + ENDIF + ENDDO - write(LOGNAM,*) 'cmf::sediment_output_write: end' - endif + write(LOGNAM,*) 'cmf::sediment_output_write: END' + ENDIF - d2sedv_avg(:,:,:) = 0._JPRB - sadd_out = 0._JPRB + d2sedv_avg(:,:,:) = 0._JPRB + sadd_out = 0._JPRB -contains - subroutine wrte_outcdf + CONTAINS + SUBROUTINE wrte_outcdf #ifdef UseCDF_CMF - use NETCDF - use YOS_CMF_TIME, only: KMINSTART, KMINNEXT - use CMF_UTILS_MOD, only: NCERROR + USE NETCDF + USE YOS_CMF_TIME, only: KMINSTART, KMINNEXT + USE CMF_UTILS_MOD, only: NCERROR - implicit none - save - real(kind=JPRB) :: xtime - xtime = real( (KMINNEXT-KMINSTART), JPRB) *60._JPRB - call NCERROR( nf90_put_var(varout(jf)%ncid,varout(jf)%timid,xtime,(/varout(jf)%irecnc/)) ) + IMPLICIT NONE + SAVE + real(kind=JPRB) :: xtime + xtime = real( (KMINNEXT-KMINSTART), JPRB) *60._JPRB + CALL NCERROR( nf90_put_var(varout(jf)%ncid,varout(jf)%timid,xtime,(/varout(jf)%irecnc/)) ) - call NCERROR( nf90_put_var(varout(jf)%ncid,varout(jf)%varid,r3out(1:NX,1:NY,1:nsed),& - (/1,1,1,varout(jf)%irecnc/),(/NX,NY,nsed,1/)) ) - - ! update irec - varout(jf)%irecnc=varout(jf)%irecnc+1 + CALL NCERROR( nf90_put_var(varout(jf)%ncid,varout(jf)%varid,r3out(1:NX,1:NY,1:nsed),& + (/1,1,1,varout(jf)%irecnc/),(/NX,NY,nsed,1/)) ) + + ! update irec + varout(jf)%irecnc=varout(jf)%irecnc+1 #endif - end subroutine wrte_outcdf - !========================================================== - subroutine wrte_outbin(ifn,irec,r2outdat) - - implicit none - !*** input - save - integer(kind=JPIM),intent(in) :: ifn !! file number - integer(kind=JPIM),intent(in) :: irec !! record - real(kind=JPRM) :: r2outdat(NX,NY,nsed) - !================================================ - write(ifn,rec=irec) r2outdat - end subroutine wrte_outbin - !========================================================== - subroutine wrte_outvec(ifn,irec,d2outdat) + END SUBROUTINE wrte_outcdf + !========================================================== + SUBROUTINE wrte_outbin(ifn,irec,r2outdat) + + IMPLICIT NONE + !*** input + SAVE + integer(kind=JPIM),intent(in) :: ifn !! file number + integer(kind=JPIM),intent(in) :: irec !! record + real(kind=JPRM) :: r2outdat(NX,NY,nsed) + !================================================ + write(ifn,rec=irec) r2outdat + END SUBROUTINE wrte_outbin + !========================================================== + SUBROUTINE wrte_outvec(ifn,irec,d2outdat) - implicit none - !*** input - save - integer(kind=JPIM),intent(in) :: ifn !! file number - integer(kind=JPIM),intent(in) :: irec !! record - real(kind=JPRB),intent(in) :: d2outdat(NSEQMAX,nsed) !! output data - !*** local - real(kind=JPRM) :: r2outdat(NSEQMAX,nsed) - !================================================ - r2outdat(:,:)=real(d2outdat(:,:)) - write(ifn,rec=irec) r2outdat - end subroutine wrte_outvec - !========================================================== -end subroutine cmf_sed_output -!========================================================== -!+ -!========================================================== -subroutine sediment_output_end + IMPLICIT NONE + !*** input + SAVE + integer(kind=JPIM),intent(in) :: ifn !! file number + integer(kind=JPIM),intent(in) :: irec !! record + real(kind=JPRB),intent(in) :: d2outdat(NSEQMAX,nsed) !! output data + !*** local + real(kind=JPRM) :: r2outdat(NSEQMAX,nsed) + !================================================ + r2outdat(:,:)=real(d2outdat(:,:)) + write(ifn,rec=irec) r2outdat + END SUBROUTINE wrte_outvec + !========================================================== + END SUBROUTINE cmf_sed_output + !========================================================== + !+ + !========================================================== + SUBROUTINE sediment_output_end #ifdef UseCDF_CMF - use NETCDF - use CMF_UTILS_MOD, only: NCERROR + USE NETCDF + USE CMF_UTILS_MOD, only: NCERROR #endif - use YOS_CMF_MAP, only: REGIONTHIS + USE YOS_CMF_MAP, only: REGIONTHIS - implicit none - save - integer(kind=JPIM) :: jf + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: jf - write(LOGNAM,*) "" - write(LOGNAM,*) "!---------------------!" - write(LOGNAM,*) "sediment_output_end: finalize output module" + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) "sediment_output_end: finalize output MODULE" - if ( LOUTVEC ) then - do jf = 1, nvarsout - close(varout(jf)%binid) - enddo - else if ( REGIONTHIS==1 ) then - do jf = 1, nvarsout - if ( LOUTCDF ) then + IF ( LOUTVEC ) THEN + DO jf = 1, nvarsout + close(varout(jf)%binid) + ENDDO + ELSE IF ( REGIONTHIS==1 ) THEN + DO jf = 1, nvarsout + IF ( LOUTCDF ) THEN #ifdef UseCDF_CMF - call NCERROR( nf90_close(varout(jf)%ncid) ) + CALL NCERROR( nf90_close(varout(jf)%ncid) ) #endif - else - close(varout(jf)%binid) - endif - enddo - endif + ELSE + close(varout(jf)%binid) + ENDIF + ENDDO + ENDIF - write(LOGNAM,*) 'sediment_output_end: end' -end subroutine sediment_output_end + write(LOGNAM,*) 'sediment_output_end: END' + END SUBROUTINE sediment_output_end -end module cmf_ctrl_sedout_mod +END MODULE cmf_ctrl_sedout_mod diff --git a/CaMa/src/sediment/cmf_ctrl_sedrest_mod.F90 b/CaMa/src/sediment/cmf_ctrl_sedrest_mod.F90 index a3a607db..cc9ade55 100755 --- a/CaMa/src/sediment/cmf_ctrl_sedrest_mod.F90 +++ b/CaMa/src/sediment/cmf_ctrl_sedrest_mod.F90 @@ -1,10 +1,10 @@ -module cmf_ctrl_sedrest_mod +MODULE cmf_ctrl_sedrest_mod !========================================================== !* PURPOSE: physics for sediment transport ! (C) M.Hatono (Hiroshima-U) May 2021 ! ! Licensed under the Apache License, Version 2.0 (the "License"); -! You may not use this file except in compliance with the License. +! You may not USE this file except in compliance with the License. ! You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software distributed under the License is @@ -12,182 +12,182 @@ module cmf_ctrl_sedrest_mod ! See the License for the specific language governing permissions and limitations under the License. !========================================================== #ifdef UseMPI_CMF - use MPI + USE MPI #endif - use PARKIND1, only: JPIM, JPRM - use YOS_CMF_INPUT, only: LOGNAM, NX, NY - use YOS_CMF_MAP, only: MPI_COMM_CAMA, NSEQALL, NSEQMAX, REGIONTHIS - use CMF_UTILS_MOD, only: INQUIRE_FID - use yos_cmf_sed, only: nsed, totlyrnum, d2layer, d2sedcon, d2seddep - - implicit none - save - integer(kind=JPIM) :: ifrq_rst_sed - character(len=256) :: sedrest_infile, sedrest_outpre - - namelist/sediment_restart/ sedrest_infile, sedrest_outpre, ifrq_rst_sed - -contains -!#################################################################### -! -- sediment_restart_init -! -- sediment_restart_write -! -- -!#################################################################### -subroutine sediment_restart_init - use YOS_CMF_MAP, only: D2RIVLEN, D2RIVWTH - use YOS_CMF_PROG, only: P2RIVSTO - use yos_cmf_sed, only: d2sedfrc, lyrdph, d2rivsto_pre, & - d2rivout_sed, d2rivvel_sed, sadd_riv, sadd_out - use CMF_UTILS_MOD, only: mapR2vecD, inquire_fid - - implicit none - save + USE PARKIND1, only: JPIM, JPRM + USE YOS_CMF_INPUT, only: LOGNAM, NX, NY + USE YOS_CMF_MAP, only: MPI_COMM_CAMA, NSEQALL, NSEQMAX, REGIONTHIS + USE CMF_UTILS_MOD, only: INQUIRE_FID + USE yos_cmf_sed, only: nsed, totlyrnum, d2layer, d2sedcon, d2seddep + + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: ifrq_rst_sed + character(len=256) :: sedrest_infile, sedrest_outpre + + namelist/sediment_restart/ sedrest_infile, sedrest_outpre, ifrq_rst_sed + +CONTAINS + !#################################################################### + ! -- sediment_restart_init + ! -- sediment_restart_write + ! -- + !#################################################################### + SUBROUTINE sediment_restart_init + USE YOS_CMF_MAP, only: D2RIVLEN, D2RIVWTH + USE YOS_CMF_PROG, only: P2RIVSTO + USE yos_cmf_sed, only: d2sedfrc, lyrdph, d2rivsto_pre, & + d2rivout_sed, d2rivvel_sed, sadd_riv, sadd_out + USE CMF_UTILS_MOD, only: mapR2vecD, inquire_fid + + IMPLICIT NONE + SAVE #ifdef UseMPI_CMF - integer(kind=JPIM) :: ierr + integer(kind=JPIM) :: ierr #endif - integer(kind=JPIM) :: ilyr, irec, ised, iseq, tmpnam, nsetfile - real(kind=JPRM) :: r2temp(NX,NY) - - nsetfile = inquire_fid() - open(nsetfile, file='input_sed.nam', status='old') - rewind(nsetfile) - read(nsetfile,nml=sediment_restart) - close(nsetfile) - - if ( sedrest_infile == "" ) then ! set layer/bedload if no restart file - !$omp parallel do - do iseq = 1, NSEQALL - d2layer(iseq,:) = lyrdph * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2sedfrc(iseq,:) - do ilyr = 1, totlyrnum-1 - d2seddep(iseq,ilyr,:) = d2layer(iseq,:) - enddo - d2seddep(iseq,totlyrnum,:) = ( max(10.d0-lyrdph*totlyrnum,0.d0) ) * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2sedfrc(iseq,:) - enddo - !$omp end parallel do - - else - if ( REGIONTHIS == 1 ) then - tmpnam = INQUIRE_FID() - open(tmpnam,file=sedrest_infile,form='unformatted',access='direct',recl=4*NX*NY) - endif - do irec = 1, 2 - do ised = 1, nsed - if ( REGIONTHIS == 1 ) read(tmpnam,rec=(irec-1)*nsed+ised) r2temp + integer(kind=JPIM) :: ilyr, irec, ised, iseq, tmpnam, nsetfile + real(kind=JPRM) :: r2temp(NX,NY) + + nsetfile = inquire_fid() + open(nsetfile, file='input_sed.nam', status='old') + rewind(nsetfile) + read(nsetfile,nml=sediment_restart) + close(nsetfile) + + IF ( sedrest_infile == "" ) THEN ! set layer/bedload if no restart file +!$omp parallel DO + DO iseq = 1, NSEQALL + d2layer(iseq,:) = lyrdph * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2sedfrc(iseq,:) + DO ilyr = 1, totlyrnum-1 + d2seddep(iseq,ilyr,:) = d2layer(iseq,:) + ENDDO + d2seddep(iseq,totlyrnum,:) = ( max(10.d0-lyrdph*totlyrnum,0.d0) ) * D2RIVWTH(iseq,1) * D2RIVLEN(iseq,1) * d2sedfrc(iseq,:) + ENDDO +!$omp END parallel DO + + ELSE + IF ( REGIONTHIS == 1 ) THEN + tmpnam = INQUIRE_FID() + open(tmpnam,file=sedrest_infile,form='unformatted',access='direct',recl=4*NX*NY) + ENDIF + DO irec = 1, 2 + DO ised = 1, nsed + IF ( REGIONTHIS == 1 ) read(tmpnam,rec=(irec-1)*nsed+ised) r2temp #ifdef UseMPI_CMF - call MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) + CALL MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) #endif - select case(irec) - case (1) - call mapR2vecD(r2temp,d2layer(:,ised)) - case (2) - call mapR2vecD(r2temp,d2sedcon(:,ised)) - end select - enddo - enddo - - do irec = 1, totlyrnum - do ised = 1, nsed - if ( REGIONTHIS == 1 ) read(tmpnam,rec=(irec+1)*nsed+ised) r2temp + select CASE(irec) + CASE (1) + CALL mapR2vecD(r2temp,d2layer(:,ised)) + CASE (2) + CALL mapR2vecD(r2temp,d2sedcon(:,ised)) + END select + ENDDO + ENDDO + + DO irec = 1, totlyrnum + DO ised = 1, nsed + IF ( REGIONTHIS == 1 ) read(tmpnam,rec=(irec+1)*nsed+ised) r2temp #ifdef UseMPI_CMF - call MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) + CALL MPI_Bcast(r2temp(1,1),NX*NY,mpi_real4,0,MPI_COMM_CAMA,ierr) #endif - call mapR2vecD(r2temp,d2seddep(:,irec,ised)) - enddo - enddo - if ( REGIONTHIS == 1 ) close(tmpnam) - write(LOGNAM,*) 'read restart sediment',maxval(d2seddep(:,totlyrnum,:)) - endif - - allocate(d2rivsto_pre(NSEQMAX), d2rivout_sed(NSEQMAX), d2rivvel_sed(NSEQMAX)) - sadd_riv = 0.d0 - sadd_out = 0.d0 - d2rivsto_pre(:) = P2RIVSTO(:,1) - d2rivout_sed(:) = 0.d0 - d2rivvel_sed(:) = 0.d0 -end subroutine sediment_restart_init + CALL mapR2vecD(r2temp,d2seddep(:,irec,ised)) + ENDDO + ENDDO + IF ( REGIONTHIS == 1 ) close(tmpnam) + write(LOGNAM,*) 'read restart sediment',maxval(d2seddep(:,totlyrnum,:)) + ENDIF + + allocate(d2rivsto_pre(NSEQMAX), d2rivout_sed(NSEQMAX), d2rivvel_sed(NSEQMAX)) + sadd_riv = 0.d0 + sadd_out = 0.d0 + d2rivsto_pre(:) = P2RIVSTO(:,1) + d2rivout_sed(:) = 0.d0 + d2rivvel_sed(:) = 0.d0 + END SUBROUTINE sediment_restart_init !========================================================== !+ !========================================================== -subroutine sediment_restart_write - use YOS_CMF_TIME, only: KSTEP, NSTEPS, JDD, JHHMM, JHOUR, JMIN, JYYYYMMDD - use YOS_CMF_INPUT, only: CSUFBIN, RMIS - use CMF_CTRL_RESTART_MOD, only: CRESTDIR - use CMF_UTILS_MOD, only: vecD2mapR + SUBROUTINE sediment_restart_write + USE YOS_CMF_TIME, only: KSTEP, NSTEPS, JDD, JHHMM, JHOUR, JMIN, JYYYYMMDD + USE YOS_CMF_INPUT, only: CSUFBIN, RMIS + USE CMF_CTRL_RESTART_MOD, only: CRESTDIR + USE CMF_UTILS_MOD, only: vecD2mapR #ifdef UseMPI_CMF - use CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R2MAP + USE CMF_CTRL_MPI_MOD, only: CMF_MPI_AllReduce_R2MAP #endif - implicit none - save - integer(kind=JPIM) :: irec, irest, ised, tmpnam - real(kind=JPRM) :: r3final(NX,NY,nsed), r2temp(NX,NY) - character(len=256) :: cdate, cfile - - irest = 0 - - if ( ifrq_rst_sed>=0 .and. KSTEP==NSTEPS ) then !! end of run - irest = 1 - endif - - if ( ifrq_rst_sed>=1 .and. ifrq_rst_sed<=24 ) then !! at selected hour - if ( mod(JHOUR,ifrq_rst_sed)==0 .and. JMIN==0 ) then - irest = 1 - endif - endif - - if ( ifrq_rst_sed==30 ) then !! at end of month - if ( JDD==1 .and. JHOUR==0 .and. JMIN==0 ) then - irest = 1 - endif - endif - - if ( irest==1 ) then - write(LOGNAM,*) "" - write(LOGNAM,*) "!---------------------!" - write(LOGNAM,*) 'cmf::sediment_restart_write: write time: ' , JYYYYMMDD, JHHMM - - write(cdate,'(I8.8,I2.2)') JYYYYMMDD,JHOUR - cfile=trim(CRESTDIR)//TRIM(sedrest_outpre)//TRIM(cdate)//TRIM(CSUFBIN) - write(LOGNAM,*) 'wrte_rest_bin: restart file:',cfile - - !*** write restart data (2D map) - if ( REGIONTHIS == 1 ) then - tmpnam = INQUIRE_FID() - open(TMPNAM,file=cfile,form='unformatted',access='direct',recl=4*NX*NY*nsed) - endif - do irec = 1, 2 - r3final(:,:,:) = RMIS - do ised = 1, nsed - select case(irec) - case (1) - call vecD2mapR(d2layer(:,ised),r2temp) - case (2) - call vecD2mapR(d2sedcon(:,ised),r2temp) - end select + IMPLICIT NONE + SAVE + integer(kind=JPIM) :: irec, irest, ised, tmpnam + real(kind=JPRM) :: r3final(NX,NY,nsed), r2temp(NX,NY) + character(len=256) :: cdate, cfile + + irest = 0 + + IF ( ifrq_rst_sed>=0 .and. KSTEP==NSTEPS ) THEN !! END of run + irest = 1 + ENDIF + + IF ( ifrq_rst_sed>=1 .and. ifrq_rst_sed<=24 ) THEN !! at selected hour + IF ( mod(JHOUR,ifrq_rst_sed)==0 .and. JMIN==0 ) THEN + irest = 1 + ENDIF + ENDIF + + IF ( ifrq_rst_sed==30 ) THEN !! at END of month + IF ( JDD==1 .and. JHOUR==0 .and. JMIN==0 ) THEN + irest = 1 + ENDIF + ENDIF + + IF ( irest==1 ) THEN + write(LOGNAM,*) "" + write(LOGNAM,*) "!---------------------!" + write(LOGNAM,*) 'cmf::sediment_restart_write: write time: ' , JYYYYMMDD, JHHMM + + write(cdate,'(I8.8,I2.2)') JYYYYMMDD,JHOUR + cfile=trim(CRESTDIR)//TRIM(sedrest_outpre)//TRIM(cdate)//TRIM(CSUFBIN) + write(LOGNAM,*) 'wrte_rest_bin: restart file:',cfile + + !*** write restart data (2D map) + IF ( REGIONTHIS == 1 ) THEN + tmpnam = INQUIRE_FID() + open(TMPNAM,file=cfile,form='unformatted',access='direct',recl=4*NX*NY*nsed) + ENDIF + DO irec = 1, 2 + r3final(:,:,:) = RMIS + DO ised = 1, nsed + select CASE(irec) + CASE (1) + CALL vecD2mapR(d2layer(:,ised),r2temp) + CASE (2) + CALL vecD2mapR(d2sedcon(:,ised),r2temp) + END select #ifdef UseMPI_CMF - call CMF_MPI_AllReduce_R2MAP(r2temp) + CALL CMF_MPI_AllReduce_R2MAP(r2temp) #endif - r3final(:,:,ised) = r2temp(:,:) - enddo - if ( REGIONTHIS == 1 ) write(tmpnam,rec=irec) r3final - enddo - - do irec = 1, totlyrnum - r3final(:,:,:) = RMIS - do ised = 1, nsed - call vecD2mapR(d2seddep(:,irec,ised),r2temp) + r3final(:,:,ised) = r2temp(:,:) + ENDDO + IF ( REGIONTHIS == 1 ) write(tmpnam,rec=irec) r3final + ENDDO + + DO irec = 1, totlyrnum + r3final(:,:,:) = RMIS + DO ised = 1, nsed + CALL vecD2mapR(d2seddep(:,irec,ised),r2temp) #ifdef UseMPI_CMF - call CMF_MPI_AllReduce_R2MAP(r2temp) + CALL CMF_MPI_AllReduce_R2MAP(r2temp) #endif - r3final(:,:,ised) = r2temp - enddo - if ( REGIONTHIS == 1 ) write(tmpnam,rec=irec+2) r3final - enddo + r3final(:,:,ised) = r2temp + ENDDO + IF ( REGIONTHIS == 1 ) write(tmpnam,rec=irec+2) r3final + ENDDO - if ( REGIONTHIS == 1 ) close(tmpnam) + IF ( REGIONTHIS == 1 ) close(tmpnam) - endif -end subroutine sediment_restart_write -!#################################################################### + ENDIF + END SUBROUTINE sediment_restart_write + !#################################################################### -end module cmf_ctrl_sedrest_mod +END MODULE cmf_ctrl_sedrest_mod diff --git a/CaMa/src/sediment/sed_utils_mod.F90 b/CaMa/src/sediment/sed_utils_mod.F90 index ea214f4a..0a674c4c 100755 --- a/CaMa/src/sediment/sed_utils_mod.F90 +++ b/CaMa/src/sediment/sed_utils_mod.F90 @@ -1,4 +1,4 @@ -module sed_utils_mod +MODULE sed_utils_mod !========================================================== !* PURPOSE: Shared ulitity functions/subroutines for CaMa-Flood sediment scheme ! (C) M. Hatono (Hiroshima Univ) Jan 2023 @@ -11,71 +11,71 @@ module sed_utils_mod ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -contains -!#################################################################### -!-- splitchar : same function as splitting characters in CaMa -!-- sed_diag_average : -!-- sed_diag_reset : -!#################################################################### -subroutine splitchar(allvars,vnames) - ! same function as splitting characters in CaMa - use PARKIND1, only: JPIM - implicit none - save - character(len=256), intent(in) :: allvars - character(len=256), intent(out) :: vnames(:) - integer(kind=JPIM) :: nvarsout, j0, j - character(len=256) :: ctmp +CONTAINS + !#################################################################### + !-- splitchar : same function as splitting characters in CaMa + !-- sed_diag_average : + !-- sed_diag_reset : + !#################################################################### + SUBROUTINE splitchar(allvars,vnames) + ! same function as splitting characters in CaMa + USE PARKIND1, only: JPIM + IMPLICIT NONE + SAVE + character(len=256), intent(in) :: allvars + character(len=256), intent(out) :: vnames(:) + integer(kind=JPIM) :: nvarsout, j0, j + character(len=256) :: ctmp - nvarsout = 0 - j0 = 1 - do j = 1, len(trim(allvars)) - if ( (j>j0) .and. (allvars(j:j).eq.',') ) then - ctmp = trim(adjustl(allvars(j0:j-1))) - if ( len(ctmp) > 0 ) then - nvarsout = nvarsout + 1 - vnames(nvarsout) = ctmp - endif - j0 = j + 1 - endif - enddo + nvarsout = 0 + j0 = 1 + DO j = 1, len(trim(allvars)) + IF ( (j>j0) .and. (allvars(j:j).eq.',') ) THEN + ctmp = trim(adjustl(allvars(j0:j-1))) + IF ( len(ctmp) > 0 ) THEN + nvarsout = nvarsout + 1 + vnames(nvarsout) = ctmp + ENDIF + j0 = j + 1 + ENDIF + ENDDO - ! last one - if ( j0 < len(trim(allvars)) ) then - j = len(trim(allvars)) - ctmp = trim(adjustl(allvars(j0:j))) - if ( len(ctmp) > 0 ) then - nvarsout = nvarsout + 1 - vnames(nvarsout) = ctmp - endif - endif -end subroutine splitchar -!========================================================== -!+ -!========================================================== -subroutine sed_diag_average - use yos_cmf_sed, only: d2rivout_sed, d2rivvel_sed, sadd_riv - implicit none + ! last one + IF ( j0 < len(trim(allvars)) ) THEN + j = len(trim(allvars)) + ctmp = trim(adjustl(allvars(j0:j))) + IF ( len(ctmp) > 0 ) THEN + nvarsout = nvarsout + 1 + vnames(nvarsout) = ctmp + ENDIF + ENDIF + END SUBROUTINE splitchar + !========================================================== + !+ + !========================================================== + SUBROUTINE sed_diag_average + USE yos_cmf_sed, only: d2rivout_sed, d2rivvel_sed, sadd_riv + IMPLICIT NONE - d2rivout_sed(:) = d2rivout_sed(:) /dble(sadd_riv) - d2rivvel_sed(:) = d2rivvel_sed(:) /dble(sadd_riv) -end subroutine sed_diag_average -!========================================================== -!+ -!========================================================== -subroutine sed_diag_reset - use PARKIND1, only: JPRB - use YOS_CMF_PROG, only: P2RIVSTO - use yos_cmf_sed, only: d2rivsto_pre, d2rivout_sed, d2rivvel_sed, & - sadd_riv, sadd_out, sedDT - implicit none + d2rivout_sed(:) = d2rivout_sed(:) /dble(sadd_riv) + d2rivvel_sed(:) = d2rivvel_sed(:) /dble(sadd_riv) + END SUBROUTINE sed_diag_average + !========================================================== + !+ + !========================================================== + SUBROUTINE sed_diag_reset + USE PARKIND1, only: JPRB + USE YOS_CMF_PROG, only: P2RIVSTO + USE yos_cmf_sed, only: d2rivsto_pre, d2rivout_sed, d2rivvel_sed, & + sadd_riv, sadd_out, sedDT + IMPLICIT NONE - sadd_riv = 0 - d2rivout_sed(:) = 0._JPRB - d2rivvel_sed(:) = 0._JPRB - d2rivsto_pre(:) = P2RIVSTO(:,1) + sadd_riv = 0 + d2rivout_sed(:) = 0._JPRB + d2rivvel_sed(:) = 0._JPRB + d2rivsto_pre(:) = P2RIVSTO(:,1) - sadd_out = sadd_out + sedDT -end subroutine sed_diag_reset + sadd_out = sadd_out + sedDT + END SUBROUTINE sed_diag_reset !#################################################################### -end module sed_utils_mod +END MODULE sed_utils_mod diff --git a/CaMa/src/sediment/yos_cmf_sed.F90 b/CaMa/src/sediment/yos_cmf_sed.F90 index 401a0a11..9f4a6e1e 100755 --- a/CaMa/src/sediment/yos_cmf_sed.F90 +++ b/CaMa/src/sediment/yos_cmf_sed.F90 @@ -1,55 +1,55 @@ -module yos_cmf_sed +MODULE yos_cmf_sed !========================================================== !* PURPOSE: Shared variables for sediment in ILS ! (C) M.Hatono (Hiroshima-U) May 2021 !========================================================== - use PARKIND1, only: JPIM, JPRB - implicit none - save - !================================================ - integer(kind=JPIM) :: nsed ! number of sediment particle size - integer(kind=JPIM) :: psedDT ! number of timestep within river timestep (DT/sedDT) - integer(kind=JPIM) :: totlyrnum ! number of deposition layers - - logical :: revEgia ! if use Egiazoroff - logical :: lsedflw ! if calculate sediment - - real(kind=JPRB) :: lambda ! porosity (default:0.4) - real(kind=JPRB) :: lyrdph ! exchange layer depth - real(kind=JPRB) :: psedD ! density of sediment (default:2.65g/m3) - real(kind=JPRB) :: pset ! parameter for setting velocity - real(kind=JPRB) :: pwatD ! density of water (default:1g/m3) - real(kind=JPRB) :: visKin ! viscosity (default:1e-6) - real(kind=JPRB) :: vonKar ! von Karman coefficient (default: 0.4) - - real(kind=JPRB),allocatable,target :: d2sedv(:,:,:) ! storage array for sediment variables - real(kind=JPRB),pointer :: d2bedout(:,:) ! bedflow (m3/s) - real(kind=JPRB),pointer :: d2layer(:,:) ! exchange layer storage (m3) - real(kind=JPRB),pointer :: d2netflw(:,:) ! suspension - deposition (m3/s) - real(kind=JPRB),pointer :: d2sedcon(:,:) ! suspended sediment concentration (m3/m3) - real(kind=JPRB),pointer :: d2sedfrc(:,:) ! sediment distribution fraction [-] - real(kind=JPRB),pointer :: d2sedout(:,:) ! suspended sediment flow (m3/s) - real(kind=JPRB),pointer :: d2sedinp(:,:) ! sediment inflow (m3/s) - - real(kind=JPRB),allocatable,target :: d2depv(:,:,:) ! storage array for sediment variables - real(kind=JPRB),pointer :: d2seddep(:,:,:) ! deposition storage - - real(kind=JPRB),allocatable,target :: d2sedv_avg(:,:,:) ! storage array for averaged sediment variables - real(kind=JPRB),pointer :: d2bedout_avg(:,:) ! bedflow (m3/s) - real(kind=JPRB),pointer :: d2netflw_avg(:,:) ! suspension - deposition (m3/s) - real(kind=JPRB),pointer :: d2sedout_avg(:,:) ! suspended sediment flow (m3/s) - real(kind=JPRB),pointer :: d2sedinp_avg(:,:) ! sediment inflow (m3/s) - - real(kind=JPRB),allocatable :: sDiam(:) ! sediment diameter - real(kind=JPRB),allocatable :: setVel(:) ! setting velocity (m/s) - - integer(kind=JPIM) :: STEP_SED ! number of river timesteps within sediment timestep (sedDT/DT) - real(kind=JPRB) :: sadd_riv ! sum DT to calculate river variable average for sediment - real(kind=JPRB) :: sadd_out ! sum sedDT to calculate output average - real(kind=JPRB) :: sedDT ! sediment timestep (s) - real(kind=JPRB),allocatable :: d2rivout_sed(:) ! accumulate rivout at DT to average into sedDT - real(kind=JPRB),allocatable :: d2rivvel_sed(:) ! accumulate rivvel at DT to average into sedDT - real(kind=JPRB),allocatable :: d2rivsto_pre(:) ! save river storage from previous timestep + USE PARKIND1, only: JPIM, JPRB + IMPLICIT NONE + SAVE + !================================================ + integer(kind=JPIM) :: nsed ! number of sediment particle size + integer(kind=JPIM) :: psedDT ! number of timestep within river timestep (DT/sedDT) + integer(kind=JPIM) :: totlyrnum ! number of deposition layers + + logical :: revEgia ! if USE Egiazoroff + logical :: lsedflw ! if calculate sediment + + real(kind=JPRB) :: lambda ! porosity (default:0.4) + real(kind=JPRB) :: lyrdph ! exchange layer depth + real(kind=JPRB) :: psedD ! density of sediment (default:2.65g/m3) + real(kind=JPRB) :: pset ! parameter for setting velocity + real(kind=JPRB) :: pwatD ! density of water (default:1g/m3) + real(kind=JPRB) :: visKin ! viscosity (default:1e-6) + real(kind=JPRB) :: vonKar ! von Karman coefficient (default: 0.4) + + real(kind=JPRB),allocatable,target :: d2sedv(:,:,:) ! storage array for sediment variables + real(kind=JPRB),pointer :: d2bedout(:,:) ! bedflow (m3/s) + real(kind=JPRB),pointer :: d2layer(:,:) ! exchange layer storage (m3) + real(kind=JPRB),pointer :: d2netflw(:,:) ! suspension - deposition (m3/s) + real(kind=JPRB),pointer :: d2sedcon(:,:) ! suspended sediment concentration (m3/m3) + real(kind=JPRB),pointer :: d2sedfrc(:,:) ! sediment distribution fraction [-] + real(kind=JPRB),pointer :: d2sedout(:,:) ! suspended sediment flow (m3/s) + real(kind=JPRB),pointer :: d2sedinp(:,:) ! sediment inflow (m3/s) + + real(kind=JPRB),allocatable,target :: d2depv(:,:,:) ! storage array for sediment variables + real(kind=JPRB),pointer :: d2seddep(:,:,:) ! deposition storage + + real(kind=JPRB),allocatable,target :: d2sedv_avg(:,:,:) ! storage array for averaged sediment variables + real(kind=JPRB),pointer :: d2bedout_avg(:,:) ! bedflow (m3/s) + real(kind=JPRB),pointer :: d2netflw_avg(:,:) ! suspension - deposition (m3/s) + real(kind=JPRB),pointer :: d2sedout_avg(:,:) ! suspended sediment flow (m3/s) + real(kind=JPRB),pointer :: d2sedinp_avg(:,:) ! sediment inflow (m3/s) + + real(kind=JPRB),allocatable :: sDiam(:) ! sediment diameter + real(kind=JPRB),allocatable :: setVel(:) ! setting velocity (m/s) + + integer(kind=JPIM) :: STEP_SED ! number of river timesteps within sediment timestep (sedDT/DT) + real(kind=JPRB) :: sadd_riv ! sum DT to calculate river variable average for sediment + real(kind=JPRB) :: sadd_out ! sum sedDT to calculate output average + real(kind=JPRB) :: sedDT ! sediment timestep (s) + real(kind=JPRB),allocatable :: d2rivout_sed(:) ! accumulate rivout at DT to average into sedDT + real(kind=JPRB),allocatable :: d2rivvel_sed(:) ! accumulate rivvel at DT to average into sedDT + real(kind=JPRB),allocatable :: d2rivsto_pre(:) ! SAVE river storage from previous timestep -!================================================ -end module yos_cmf_sed + !================================================ +END MODULE yos_cmf_sed diff --git a/CaMa/src/yos_cmf_diag.F90 b/CaMa/src/yos_cmf_diag.F90 index 50159651..9204d817 100755 --- a/CaMa/src/yos_cmf_diag.F90 +++ b/CaMa/src/yos_cmf_diag.F90 @@ -13,90 +13,90 @@ MODULE YOS_CMF_DIAG ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM, JPRD -IMPLICIT NONE -SAVE -!================================================ -!*** Inst. diagnostics -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2DIAG(:,:,:) !! Storage array for average diagnostics - -REAL(KIND=JPRB),POINTER :: D2RIVINF(:,:) !! river inflow [m3/s] (from upstream) -REAL(KIND=JPRB),POINTER :: D2RIVDPH(:,:) !! river depth [m] -REAL(KIND=JPRB),POINTER :: D2RIVVEL(:,:) !! flow velocity [m/s] - -REAL(KIND=JPRB),POINTER :: D2FLDINF(:,:) !! floodplain inflow [m3/s] -REAL(KIND=JPRB),POINTER :: D2FLDDPH(:,:) !! floodplain depth [m] -REAL(KIND=JPRB),POINTER :: D2FLDFRC(:,:) !! flooded fractipn [m2/m2] -REAL(KIND=JPRB),POINTER :: D2FLDARE(:,:) !! flooded area [m2] - -REAL(KIND=JPRB),POINTER :: D2PTHOUT(:,:) !! flood path outflow [m3/s] -REAL(KIND=JPRB),POINTER :: D2PTHINF(:,:) !! flood path inflow [m3/s] - -REAL(KIND=JPRB),POINTER :: D2SFCELV(:,:) !! water surface elev [m] (elevtn - rivhgt + rivdph) -REAL(KIND=JPRB),POINTER :: D2OUTFLW(:,:) !! total outflow [m3/s] (rivout + fldout) -REAL(KIND=JPRB),POINTER :: D2STORGE(:,:) !! total storage [m3] (rivsto + fldsto) - -REAL(KIND=JPRB),POINTER :: D2OUTINS(:,:) !! instantaneous discharge [m3/s] (unrouted runoff) -REAL(KIND=JPRB),POINTER :: D2WEVAPEX(:,:) !! Evaporation water extracted -REAL(KIND=JPRB),POINTER :: D2WINFILTEX(:,:) !! Infiltration water extracted - -INTEGER(KIND=JPIM) :: N2DIAG !! number of 2D diagnostics - -!================================================ -!*** Average diagnostics -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2DIAG_AVG(:,:,:) !! Storage array for average diagnostics (nseqmax,1,variable) - -REAL(KIND=JPRB),POINTER :: D2RIVOUT_AVG(:,:) !! average river discharge -REAL(KIND=JPRB),POINTER :: D2OUTFLW_AVG(:,:) !! average total outflow [m3/s] (rivout + fldout) !! bugfix v362 -REAL(KIND=JPRB),POINTER :: D2FLDOUT_AVG(:,:) !! average floodplain discharge -REAL(KIND=JPRB),POINTER :: D2RIVVEL_AVG(:,:) !! average flow velocity -REAL(KIND=JPRB),POINTER :: D2PTHOUT_AVG(:,:) !! flood pathway net outflow (2D) - -REAL(KIND=JPRB),POINTER :: D2GDWRTN_AVG(:,:) !! average ground water return flow -REAL(KIND=JPRB),POINTER :: D2RUNOFF_AVG(:,:) !! average input runoff -REAL(KIND=JPRB),POINTER :: D2ROFSUB_AVG(:,:) !! average input sub-surface runoff -REAL(KIND=JPRB),POINTER :: D2WEVAPEX_AVG(:,:) !! average extracted water evaporation -REAL(KIND=JPRB),POINTER :: D2WINFILTEX_AVG(:,:) !! average extracted Infiltration water - -INTEGER(KIND=JPIM) :: N2DIAG_AVG !! Number of 2D diagnostics averages -REAL(KIND=JPRB) :: NADD !! sum DT to calculate average -!*** Average diagnostics (1D) -REAL(KIND=JPRB),ALLOCATABLE :: D1PTHFLW_AVG(:,:) !! bifurcation channel flow (1D, not 2D variable) - -!================================================ -!*** Daily max diagnostics -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2DIAG_MAX(:,:,:) !! Storage array for maximum diagnostics (nseqmax,1,variable) - -REAL(KIND=JPRB),POINTER :: D2OUTFLW_MAX(:,:) !! max total outflow [m3/s] (rivout + fldout) -REAL(KIND=JPRB),POINTER :: D2STORGE_MAX(:,:) !! max total outflow [m3/s] (rivout + fldout) -REAL(KIND=JPRB),POINTER :: D2RIVDPH_MAX(:,:) !! max total outflow [m3/s] (rivout + fldout) - -INTEGER(KIND=JPRB) :: N2DIAG_MAX !! Number of 2D diagnostics maximum - -!================================================ -!*** Global total -! discharge calculation budget -REAL(KIND=JPRD) :: P0GLBSTOPRE !! global water storage [m3] (befre flow calculation) -REAL(KIND=JPRD) :: P0GLBSTONXT !! global water storage [m3] (after flow calculation) -REAL(KIND=JPRD) :: P0GLBSTONEW !! global water storage [m3] (after runoff input) -REAL(KIND=JPRD) :: P0GLBRIVINF !! global inflow [m3] (rivinf + fldinf) -REAL(KIND=JPRD) :: P0GLBRIVOUT !! global outflow [m3] (rivout + fldout) - -! stage calculation budget -REAL(KIND=JPRD) :: P0GLBSTOPRE2 !! global water storage [m3] (befre stage calculation) -REAL(KIND=JPRD) :: P0GLBSTONEW2 !! global water storage [m3] (after stage calculation) -REAL(KIND=JPRD) :: P0GLBRIVSTO !! global river storage [m3] -REAL(KIND=JPRD) :: P0GLBFLDSTO !! global floodplain storage [m3] -REAL(KIND=JPRD) :: P0GLBLEVSTO !! global protected-side storage [m3] (levee scheme) -REAL(KIND=JPRD) :: P0GLBFLDARE !! global flooded area [m2] - -!================================================ -!*** dam variable -REAL(KIND=JPRB),POINTER :: D2DAMINF_AVG(:,:) !! average reservoir inflow [m3/s] !!!added - -!================================================ -!!!*** levee variables -REAL(KIND=JPRB),POINTER :: D2LEVDPH(:,:) !! flood depth in protected side (water depth betwen river & levee) + USE PARKIND1, only: JPIM, JPRB, JPRM, JPRD + IMPLICIT NONE + SAVE + !================================================ + !*** Inst. diagnostics + real(KIND=JPRB),allocatable,target :: D2DIAG(:,:,:) !! Storage array for average diagnostics + + real(KIND=JPRB),pointer :: D2RIVINF(:,:) !! river inflow [m3/s] (from upstream) + real(KIND=JPRB),pointer :: D2RIVDPH(:,:) !! river depth [m] + real(KIND=JPRB),pointer :: D2RIVVEL(:,:) !! flow velocity [m/s] + + real(KIND=JPRB),pointer :: D2FLDINF(:,:) !! floodplain inflow [m3/s] + real(KIND=JPRB),pointer :: D2FLDDPH(:,:) !! floodplain depth [m] + real(KIND=JPRB),pointer :: D2FLDFRC(:,:) !! flooded fractipn [m2/m2] + real(KIND=JPRB),pointer :: D2FLDARE(:,:) !! flooded area [m2] + + real(KIND=JPRB),pointer :: D2PTHOUT(:,:) !! flood path outflow [m3/s] + real(KIND=JPRB),pointer :: D2PTHINF(:,:) !! flood path inflow [m3/s] + + real(KIND=JPRB),pointer :: D2SFCELV(:,:) !! water surface elev [m] (elevtn - rivhgt + rivdph) + real(KIND=JPRB),pointer :: D2OUTFLW(:,:) !! total outflow [m3/s] (rivout + fldout) + real(KIND=JPRB),pointer :: D2STORGE(:,:) !! total storage [m3] (rivsto + fldsto) + + real(KIND=JPRB),pointer :: D2OUTINS(:,:) !! instantaneous discharge [m3/s] (unrouted runoff) + real(KIND=JPRB),pointer :: D2WEVAPEX(:,:) !! Evaporation water extracted + real(KIND=JPRB),pointer :: D2WINFILTEX(:,:) !! Infiltration water extracted + + integer(KIND=JPIM) :: N2DIAG !! number of 2D diagnostics + + !================================================ + !*** Average diagnostics + real(KIND=JPRB),allocatable,target :: D2DIAG_AVG(:,:,:) !! Storage array for average diagnostics (nseqmax,1,variable) + + real(KIND=JPRB),pointer :: D2RIVOUT_AVG(:,:) !! average river discharge + real(KIND=JPRB),pointer :: D2OUTFLW_AVG(:,:) !! average total outflow [m3/s] (rivout + fldout) !! bugfix v362 + real(KIND=JPRB),pointer :: D2FLDOUT_AVG(:,:) !! average floodplain discharge + real(KIND=JPRB),pointer :: D2RIVVEL_AVG(:,:) !! average flow velocity + real(KIND=JPRB),pointer :: D2PTHOUT_AVG(:,:) !! flood pathway net outflow (2D) + + real(KIND=JPRB),pointer :: D2GDWRTN_AVG(:,:) !! average ground water return flow + real(KIND=JPRB),pointer :: D2RUNOFF_AVG(:,:) !! average input runoff + real(KIND=JPRB),pointer :: D2ROFSUB_AVG(:,:) !! average input sub-surface runoff + real(KIND=JPRB),pointer :: D2WEVAPEX_AVG(:,:) !! average extracted water evaporation + real(KIND=JPRB),pointer :: D2WINFILTEX_AVG(:,:) !! average extracted Infiltration water + + integer(KIND=JPIM) :: N2DIAG_AVG !! Number of 2D diagnostics averages + real(KIND=JPRB) :: NADD !! sum DT to calculate average + !*** Average diagnostics (1D) + real(KIND=JPRB),allocatable :: D1PTHFLW_AVG(:,:) !! bifurcation channel flow (1D, not 2D variable) + + !================================================ + !*** Daily max diagnostics + real(KIND=JPRB),allocatable,target :: D2DIAG_MAX(:,:,:) !! Storage array for maximum diagnostics (nseqmax,1,variable) + + real(KIND=JPRB),pointer :: D2OUTFLW_MAX(:,:) !! max total outflow [m3/s] (rivout + fldout) + real(KIND=JPRB),pointer :: D2STORGE_MAX(:,:) !! max total outflow [m3/s] (rivout + fldout) + real(KIND=JPRB),pointer :: D2RIVDPH_MAX(:,:) !! max total outflow [m3/s] (rivout + fldout) + + integer(KIND=JPRB) :: N2DIAG_MAX !! Number of 2D diagnostics maximum + + !================================================ + !*** Global total + ! discharge calculation budget + real(KIND=JPRD) :: P0GLBSTOPRE !! global water storage [m3] (befre flow calculation) + real(KIND=JPRD) :: P0GLBSTONXT !! global water storage [m3] (after flow calculation) + real(KIND=JPRD) :: P0GLBSTONEW !! global water storage [m3] (after runoff input) + real(KIND=JPRD) :: P0GLBRIVINF !! global inflow [m3] (rivinf + fldinf) + real(KIND=JPRD) :: P0GLBRIVOUT !! global outflow [m3] (rivout + fldout) + + ! stage calculation budget + real(KIND=JPRD) :: P0GLBSTOPRE2 !! global water storage [m3] (befre stage calculation) + real(KIND=JPRD) :: P0GLBSTONEW2 !! global water storage [m3] (after stage calculation) + real(KIND=JPRD) :: P0GLBRIVSTO !! global river storage [m3] + real(KIND=JPRD) :: P0GLBFLDSTO !! global floodplain storage [m3] + real(KIND=JPRD) :: P0GLBLEVSTO !! global protected-side storage [m3] (levee scheme) + real(KIND=JPRD) :: P0GLBFLDARE !! global flooded area [m2] + + !================================================ + !*** dam variable + real(KIND=JPRB),pointer :: D2DAMINF_AVG(:,:) !! average reservoir inflow [m3/s] !!!added + + !================================================ + !!!*** levee variables + real(KIND=JPRB),pointer :: D2LEVDPH(:,:) !! flood depth in protected side (water depth betwen river & levee) diff --git a/CaMa/src/yos_cmf_input.F90 b/CaMa/src/yos_cmf_input.F90 index da36fa76..79681a0d 100755 --- a/CaMa/src/yos_cmf_input.F90 +++ b/CaMa/src/yos_cmf_input.F90 @@ -14,119 +14,119 @@ MODULE YOS_CMF_INPUT ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -IMPLICIT NONE -SAVE -!================================================ -!*** CMF default files -LOGICAL :: LLOGOUT !! true: log output to file -INTEGER(KIND=JPIM) :: LOGNAM !! default log file FID -INTEGER(KIND=JPIM) :: NSETFILE !! input namelist file FID -INTEGER(KIND=JPIM) :: TMPNAM !! temporal I/O file FIG -CHARACTER(LEN=256) :: CLOGOUT !! default log file name -CHARACTER(LEN=256) :: CSETFILE !! input namelist file name - -DATA LLOGOUT /.TRUE./ -DATA CLOGOUT /'../run/log_CaMa.txt'/ -DATA CSETFILE /'../run/cama_flood.nml'/ - -!================================================ -!*** NAMELIST/NRUNVER/ -LOGICAL :: LADPSTP !! true: use adaptive time step - -LOGICAL :: LFPLAIN !! true: consider floodplain (false: only river channel) -LOGICAL :: LKINE !! true: use kinematic wave -LOGICAL :: LFLDOUT !! true: floodplain flow (high-water channel flow) active -LOGICAL :: LPTHOUT !! true: activate bifurcation scheme -LOGICAL :: LDAMOUT !! true: activate dam operation (under development) -LOGICAL :: LLEVEE !! true: activate levee scheme (under development) - -!~~ used in ECMWF -LOGICAL :: LROSPLIT !! true: input if surface (Qs) and sub-surface (Qsb) runoff -LOGICAL :: LWEVAP !! true: input water evaporation to extract from floodplain -LOGICAL :: LWEVAPFIX !! true: water balance closure extracting water from evap when available -LOGICAL :: LWINFILT !! true: input water infiltration to extract from floodplain -LOGICAL :: LWINFILTFIX !! true: water balance closure extracting water from Infiltration when available -LOGICAL :: LWEXTRACTRIV !! true: also extract water from rivers -LOGICAL :: LSLOPEMOUTH !! true: prescribe water level slope == elevation slope on river month -LOGICAL :: LGDWDLY !! true: Activate ground water reservoir and delay -LOGICAL :: LSLPMIX !! true: activate mixed kinematic and local inertia based on slope - -LOGICAL :: LMEANSL !! true : boundary condition for mean sea level -LOGICAL :: LSEALEV !! true : boundary condition for variable sea level - -LOGICAL :: LOUTINS !! true: diagnose instantaneous discharge - -LOGICAL :: LRESTART !! true: initial condition from restart file -LOGICAL :: LSTOONLY !! true: storage only restart (mainly for data assimilation) - -LOGICAL :: LOUTPUT !! true: use standard output (to file) -LOGICAL :: LOUTINI !! true: output initial storage (netCDF only) - -LOGICAL :: LGRIDMAP !! true: for standard XY gridded 2D map -LOGICAL :: LLEAPYR !! true: neglect leap year (Feb29 skipped) -LOGICAL :: LMAPEND !! true: for map data endian conversion -LOGICAL :: LBITSAFE !! true: for Bit Identical (removed from v410, set in Mkinclude) -LOGICAL :: LSTG_ES !! true: for Vector Processor optimization (CMF_OPT_FLDSTG_ES) - -LOGICAL :: LSEDOUT !! true: sediment scheme - -!================================================ -!*** NAMELIST/NCONF/ -CHARACTER(LEN=256) :: CDIMINFO !! Dimention Information - -REAL(KIND=JPRB) :: DT !! Time Step Length [SEC] (should be multiple of 60) - -INTEGER(KIND=JPIM) :: IFRQ_OUT !! [hour]: frequency to write output e.g. (1,2,3,6,12,24) hour -INTEGER(KIND=JPIM) :: IFRQ_INP !! [hour]: frequency to update runoff e.g. (1,2,3,6,12,24) hour -INTEGER(KIND=JPIM) :: IFRQ_SL !! [min]: frequency to update sea level e.g. (1,2,5,10,15,20,30,60) min - -!*** set by CDIMINFO -INTEGER(KIND=JPIM) :: NX !! NUMBER OF GRIDS IN HORIZONTAL -INTEGER(KIND=JPIM) :: NY !! NUMBER OF GRIDS IN VERTICAL -INTEGER(KIND=JPIM) :: NLFP !! NUMBER OF VERTICAL LEVELS DEFINING FLOODPLAIN - -INTEGER(KIND=JPIM) :: NXIN !! NUMBER OF GRIDS IN HORIZONTAL -INTEGER(KIND=JPIM) :: NYIN !! NUMBER OF GRIDS IN VERTICAL -INTEGER(KIND=JPIM) :: INPN !! MAX INPUT NUMBER - -REAL(KIND=JPRB) :: WEST !! west, east, north, south edge of the domain [deg] -REAL(KIND=JPRB) :: EAST -REAL(KIND=JPRB) :: NORTH -REAL(KIND=JPRB) :: SOUTH - -!*** calculated from IFRQ & DT -REAL(KIND=JPRB) :: DTIN !! SECOND IN INPUT TIME STEP [SEC] -REAL(KIND=JPRB) :: DTSL !! SECOND IN TIME STEP [SEC] - -!================================================ -!*** NAMELIST/PARAM/ -!* parameters -REAL(KIND=JPRB) :: PMANRIV !! manning roughness (river) -REAL(KIND=JPRB) :: PMANFLD !! manning roughness (floodplain) -REAL(KIND=JPRB) :: PGRV !! gravity acceleration [m/s2] -REAL(KIND=JPRB) :: PDSTMTH !! downstream distance at river mouth [m] -REAL(KIND=JPRB) :: PCADP !! CFL coefficient -REAL(KIND=JPRB) :: PMINSLP !! minimum topographic slope (kinematic wave) [m/m] -!* missing values -INTEGER(KIND=JPIM) :: IMIS !! integer undefined -REAL(KIND=JPRM) :: RMIS !! real undefined -REAL(KIND=JPRB) :: DMIS !! double undefined -!* file suffix -CHARACTER(LEN=256) :: CSUFBIN ! .bin suffix for binary (2D map) -CHARACTER(LEN=256) :: CSUFVEC ! .vec suffix for binary (1D vector) -CHARACTER(LEN=256) :: CSUFPTH ! .pth suffix for binary (1D bifurcation channel) -CHARACTER(LEN=256) :: CSUFCDF ! .nc suffix for netCDF + USE PARKIND1, ONLY: JPIM, JPRB, JPRM + IMPLICIT NONE + SAVE + !================================================ + !*** CMF default files + logical :: LLOGOUT !! true: log output to file + integer(KIND=JPIM) :: LOGNAM !! default log file FID + integer(KIND=JPIM) :: NSETFILE !! input namelist file FID + integer(KIND=JPIM) :: TMPNAM !! temporal I/O file FIG + character(LEN=256) :: CLOGOUT !! default log file name + character(LEN=256) :: CSETFILE !! input namelist file name + + DATA LLOGOUT /.TRUE./ + DATA CLOGOUT /'../run/log_CaMa.txt'/ + DATA CSETFILE /'../run/cama_flood.nml'/ + + !================================================ + !*** NAMELIST/NRUNVER/ + logical :: LADPSTP !! true: use adaptive time step + + logical :: LFPLAIN !! true: consider floodplain (false: only river channel) + logical :: LKINE !! true: use kinematic wave + logical :: LFLDOUT !! true: floodplain flow (high-water channel flow) active + logical :: LPTHOUT !! true: activate bifurcation scheme + logical :: LDAMOUT !! true: activate dam operation (under development) + logical :: LLEVEE !! true: activate levee scheme (under development) + + !~~ used in ECMWF + logical :: LROSPLIT !! true: input if surface (Qs) and sub-surface (Qsb) runoff + logical :: LWEVAP !! true: input water evaporation to extract from floodplain + logical :: LWEVAPFIX !! true: water balance closure extracting water from evap when available + logical :: LWINFILT !! true: input water infiltration to extract from floodplain + logical :: LWINFILTFIX !! true: water balance closure extracting water from Infiltration when available + logical :: LWEXTRACTRIV !! true: also extract water from rivers + logical :: LSLOPEMOUTH !! true: prescribe water level slope == elevation slope on river month + logical :: LGDWDLY !! true: Activate ground water reservoir and delay + logical :: LSLPMIX !! true: activate mixed kinematic and local inertia based on slope + + logical :: LMEANSL !! true : boundary condition for mean sea level + logical :: LSEALEV !! true : boundary condition for variable sea level + + logical :: LOUTINS !! true: diagnose instantaneous discharge + + logical :: LRESTART !! true: initial condition from restart file + logical :: LSTOONLY !! true: storage only restart (mainly for data assimilation) + + logical :: LOUTPUT !! true: use standard output (to file) + logical :: LOUTINI !! true: output initial storage (netCDF only) + + logical :: LGRIDMAP !! true: for standard XY gridded 2D map + logical :: LLEAPYR !! true: neglect leap year (Feb29 skipped) + logical :: LMAPEND !! true: for map data endian conversion + logical :: LBITSAFE !! true: for Bit Identical (removed from v410, set in Mkinclude) + logical :: LSTG_ES !! true: for Vector Processor optimization (CMF_OPT_FLDSTG_ES) + + logical :: LSEDOUT !! true: sediment scheme + + !================================================ + !*** NAMELIST/NCONF/ + character(LEN=256) :: CDIMINFO !! Dimention Information + + real(KIND=JPRB) :: DT !! Time Step Length [SEC] (should be multiple of 60) + + integer(KIND=JPIM) :: IFRQ_OUT !! [hour]: frequency to write output e.g. (1,2,3,6,12,24) hour + integer(KIND=JPIM) :: IFRQ_INP !! [hour]: frequency to update runoff e.g. (1,2,3,6,12,24) hour + integer(KIND=JPIM) :: IFRQ_SL !! [min]: frequency to update sea level e.g. (1,2,5,10,15,20,30,60) min + + !*** set by CDIMINFO + integer(KIND=JPIM) :: NX !! NUMBER OF GRIDS IN HORIZONTAL + integer(KIND=JPIM) :: NY !! NUMBER OF GRIDS IN VERTICAL + integer(KIND=JPIM) :: NLFP !! NUMBER OF VERTICAL LEVELS DEFINING FLOODPLAIN + + integer(KIND=JPIM) :: NXIN !! NUMBER OF GRIDS IN HORIZONTAL + integer(KIND=JPIM) :: NYIN !! NUMBER OF GRIDS IN VERTICAL + integer(KIND=JPIM) :: INPN !! MAX INPUT NUMBER + + real(KIND=JPRB) :: WEST !! west, east, north, south edge of the domain [deg] + real(KIND=JPRB) :: EAST + real(KIND=JPRB) :: NORTH + real(KIND=JPRB) :: SOUTH + + !*** calculated from IFRQ & DT + real(KIND=JPRB) :: DTIN !! SECOND IN INPUT TIME STEP [SEC] + real(KIND=JPRB) :: DTSL !! SECOND IN TIME STEP [SEC] + + !================================================ + !*** NAMELIST/PARAM/ + !* parameters + real(KIND=JPRB) :: PMANRIV !! manning roughness (river) + real(KIND=JPRB) :: PMANFLD !! manning roughness (floodplain) + real(KIND=JPRB) :: PGRV !! gravity acceleration [m/s2] + real(KIND=JPRB) :: PDSTMTH !! downstream distance at river mouth [m] + real(KIND=JPRB) :: PCADP !! CFL coefficient + real(KIND=JPRB) :: PMINSLP !! minimum topographic slope (kinematic wave) [m/m] + !* missing values + integer(KIND=JPIM) :: IMIS !! integer undefined + real(KIND=JPRM) :: RMIS !! real undefined + real(KIND=JPRB) :: DMIS !! double undefined + !* file suffix + character(LEN=256) :: CSUFBIN ! .bin suffix for binary (2D map) + character(LEN=256) :: CSUFVEC ! .vec suffix for binary (1D vector) + character(LEN=256) :: CSUFPTH ! .pth suffix for binary (1D bifurcation channel) + character(LEN=256) :: CSUFCDF ! .nc suffix for netCDF !================================================ #ifdef IFS_CMF -! Fluxes buffers for IFS coupling -REAL(KIND=JPRB), ALLOCATABLE :: ZBUFFO(:,:,:) -REAL(KIND=JPRB), ALLOCATABLE :: ZBUFFI(:,:,:) -REAL(KIND=JPRB), ALLOCATABLE :: ZACC0(:,:) -REAL(KIND=JPRB), ALLOCATABLE :: ZACC1(:,:) -!Time step to be advanced within DRV_ADVANCE used for IFS coupling -INTEGER(KIND=JPIM) :: ISTEPADV -!=============================================== + ! Fluxes buffers for IFS coupling + real(KIND=JPRB), ALLOCATABLE :: ZBUFFO(:,:,:) + real(KIND=JPRB), ALLOCATABLE :: ZBUFFI(:,:,:) + real(KIND=JPRB), ALLOCATABLE :: ZACC0(:,:) + real(KIND=JPRB), ALLOCATABLE :: ZACC1(:,:) + !Time step to be advanced within DRV_ADVANCE used for IFS coupling + integer(KIND=JPIM) :: ISTEPADV + !=============================================== #endif END MODULE YOS_CMF_INPUT diff --git a/CaMa/src/yos_cmf_map.F90 b/CaMa/src/yos_cmf_map.F90 index b140e65b..b596db70 100755 --- a/CaMa/src/yos_cmf_map.F90 +++ b/CaMa/src/yos_cmf_map.F90 @@ -10,74 +10,74 @@ MODULE YOS_CMF_MAP ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. -!========================================================== -USE PARKIND1, ONLY: JPIM, JPRM, JPRB -IMPLICIT NONE -SAVE -!================================================ -!*** river network -INTEGER(KIND=JPIM),ALLOCATABLE :: I2NEXTX(:,:) !! POINT DOWNSTREAM HORIZONTAL -INTEGER(KIND=JPIM),ALLOCATABLE :: I2NEXTY(:,:) !! POINT DOWNSTREAM VERTICAL + !========================================================== + USE PARKIND1, only: JPIM, JPRM, JPRB + IMPLICIT NONE + SAVE + !================================================ + !*** river network + integer(KIND=JPIM),allocatable :: I2NEXTX(:,:) !! POINT DOWNSTREAM HORIZONTAL + integer(KIND=JPIM),allocatable :: I2NEXTY(:,:) !! POINT DOWNSTREAM VERTICAL -INTEGER(KIND=JPIM),ALLOCATABLE :: I1SEQX(:) !! 1D SEQUENCE HORIZONTAL -INTEGER(KIND=JPIM),ALLOCATABLE :: I1SEQY(:) !! 1D SEQUENCE VERTICAL -INTEGER(KIND=JPIM),ALLOCATABLE :: I1NEXT(:) !! 1D DOWNSTREAM -INTEGER(KIND=JPIM) :: NSEQRIV !! LENGTH OF 1D SEQUNECE FOR RIVER -INTEGER(KIND=JPIM) :: NSEQALL !! LENGTH OF 1D SEQUNECE FOR RIVER AND MOUTH -INTEGER(KIND=JPIM) :: NSEQMAX !! MAX OF NSEQALL (PARALLEL) + integer(KIND=JPIM),allocatable :: I1SEQX(:) !! 1D SEQUENCE HORIZONTAL + integer(KIND=JPIM),allocatable :: I1SEQY(:) !! 1D SEQUENCE VERTICAL + integer(KIND=JPIM),allocatable :: I1NEXT(:) !! 1D DOWNSTREAM + integer(KIND=JPIM) :: NSEQRIV !! LENGTH OF 1D SEQUNECE FOR RIVER + integer(KIND=JPIM) :: NSEQALL !! LENGTH OF 1D SEQUNECE FOR RIVER AND MOUTH + integer(KIND=JPIM) :: NSEQMAX !! MAX OF NSEQALL (PARALLEL) -INTEGER(KIND=JPIM),ALLOCATABLE :: I2VECTOR(:,:) !! VECTOR INDEX -INTEGER(KIND=JPIM),ALLOCATABLE :: I2REGION(:,:) !! REGION INDEX -INTEGER(KIND=JPIM) :: REGIONALL !! REGION TOTAL -INTEGER(KIND=JPIM) :: REGIONTHIS !! REGION THIS CPU -INTEGER(KIND=JPIM) :: MPI_COMM_CAMA !! MPI COMMUNICATOR + integer(KIND=JPIM),allocatable :: I2VECTOR(:,:) !! VECTOR INDEX + integer(KIND=JPIM),allocatable :: I2REGION(:,:) !! REGION INDEX + integer(KIND=JPIM) :: REGIONALL !! REGION TOTAL + integer(KIND=JPIM) :: REGIONTHIS !! REGION THIS CPU + integer(KIND=JPIM) :: MPI_COMM_CAMA !! MPI COMMUNICATOR -!================================================ -!*** lat, lon -REAL(KIND=JPRB),ALLOCATABLE :: D1LON(:) !! longitude [degree_east] -REAL(KIND=JPRB),ALLOCATABLE :: D1LAT(:) !! latitude [degree_north] + !================================================ + !*** lat, lon + real(KIND=JPRB),allocatable :: D1LON(:) !! longitude [degree_east] + real(KIND=JPRB),allocatable :: D1LAT(:) !! latitude [degree_north] -!================================================ -!*** River + Floodplain topography (map) -REAL(KIND=JPRB),ALLOCATABLE :: D2GRAREA(:,:) !! GRID AREA [M2] -REAL(KIND=JPRB),ALLOCATABLE :: D2ELEVTN(:,:) !! ELEVATION [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2NXTDST(:,:) !! DISTANCE TO THE NEXT GRID [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2RIVLEN(:,:) !! RIVER LENGTH [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2RIVWTH(:,:) !! RIVER WIDTH [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2RIVMAN(:,:) !! RIVER MANNING COEFFICIENT -REAL(KIND=JPRB),ALLOCATABLE :: D2RIVHGT(:,:) !! RIVER HEIGHT [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2FLDHGT(:,:,:) !! FLOODPLAIN HEIGHT [M] + !================================================ + !*** River + Floodplain topography (map) + real(KIND=JPRB),allocatable :: D2GRAREA(:,:) !! GRID AREA [M2] + real(KIND=JPRB),allocatable :: D2ELEVTN(:,:) !! ELEVATION [M] + real(KIND=JPRB),allocatable :: D2NXTDST(:,:) !! DISTANCE TO THE NEXT GRID [M] + real(KIND=JPRB),allocatable :: D2RIVLEN(:,:) !! RIVER LENGTH [M] + real(KIND=JPRB),allocatable :: D2RIVWTH(:,:) !! RIVER WIDTH [M] + real(KIND=JPRB),allocatable :: D2RIVMAN(:,:) !! RIVER MANNING COEFFICIENT + real(KIND=JPRB),allocatable :: D2RIVHGT(:,:) !! RIVER HEIGHT [M] + real(KIND=JPRB),allocatable :: D2FLDHGT(:,:,:) !! FLOODPLAIN HEIGHT [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2GDWDLY(:,:) !! Ground water delay -REAL(KIND=JPRB),ALLOCATABLE :: D2ELEVSLOPE(:,:) !! River bed slope -INTEGER(KIND=JPIM),ALLOCATABLE :: I2MASK(:,:) !! Mask + real(KIND=JPRB),allocatable :: D2GDWDLY(:,:) !! Ground water delay + real(KIND=JPRB),allocatable :: D2ELEVSLOPE(:,:) !! River bed slope + integer(KIND=JPIM),allocatable :: I2MASK(:,:) !! Mask -!================================================ -!*** Floodplain Topography (diagnosed) -REAL(KIND=JPRB),ALLOCATABLE :: D2RIVSTOMAX(:,:) !! maximum river storage [m3] -REAL(KIND=JPRB),ALLOCATABLE :: D2RIVELV(:,:) !! elevation of river bed [m3] -REAL(KIND=JPRB),ALLOCATABLE :: D2FLDSTOMAX(:,:,:) !! MAXIMUM FLOODPLAIN STORAGE [M3] -REAL(KIND=JPRB),ALLOCATABLE :: D2FLDGRD(:,:,:) !! FLOODPLAIN GRADIENT -REAL(KIND=JPRB) :: DFRCINC !! FLOODPLAIN FRACTION INCREMENT [-] (1/NLFP) + !================================================ + !*** Floodplain Topography (diagnosed) + real(KIND=JPRB),allocatable :: D2RIVSTOMAX(:,:) !! maximum river storage [m3] + real(KIND=JPRB),allocatable :: D2RIVELV(:,:) !! elevation of river bed [m3] + real(KIND=JPRB),allocatable :: D2FLDSTOMAX(:,:,:) !! MAXIMUM FLOODPLAIN STORAGE [M3] + real(KIND=JPRB),allocatable :: D2FLDGRD(:,:,:) !! FLOODPLAIN GRADIENT + real(KIND=JPRB) :: DFRCINC !! FLOODPLAIN FRACTION INCREMENT [-] (1/NLFP) -!================================================ -!*** Downstream boundary -REAL(KIND=JPRB),ALLOCATABLE :: D2MEANSL(:,:) !! MEAN SEA LEVEL [M] -REAL(KIND=JPRB),ALLOCATABLE :: D2SEALEV(:,:) !! sea level variation [m] -REAL(KIND=JPRB),ALLOCATABLE :: D2DWNELV(:,:) !! downstream boundary elevation [m] + !================================================ + !*** Downstream boundary + real(KIND=JPRB),allocatable :: D2MEANSL(:,:) !! MEAN SEA LEVEL [M] + real(KIND=JPRB),allocatable :: D2SEALEV(:,:) !! sea level variation [m] + real(KIND=JPRB),allocatable :: D2DWNELV(:,:) !! downstream boundary elevation [m] -!================================================ -!*** bifurcation channel -INTEGER(KIND=JPIM) :: NPTHOUT !! NUMBER OF FLOODPLAIN PATH -INTEGER(KIND=JPIM) :: NPTHLEV !! NUMBER OF FLOODPLAIN PATH LAYER -INTEGER(KIND=JPIM),ALLOCATABLE :: PTH_UPST(:) !! FLOOD PATHWAY UPSTREAM ISEQ -INTEGER(KIND=JPIM),ALLOCATABLE :: PTH_DOWN(:) !! FLOOD PATHWAY DOWNSTREAM JSEQ -REAL(KIND=JPRB),ALLOCATABLE :: PTH_DST(:) !! FLOOD PATHWAY DISTANCE [m] -REAL(KIND=JPRB),ALLOCATABLE :: PTH_ELV(:,:) !! FLOOD PATHWAY ELEVATION [m] -REAL(KIND=JPRB),ALLOCATABLE :: PTH_WTH(:,:) !! FLOOD PATHWAY WIDTH [m] -REAL(KIND=JPRB),ALLOCATABLE :: PTH_MAN(:) !! FLOOD PATHWAY Manning + !================================================ + !*** bifurcation channel + integer(KIND=JPIM) :: NPTHOUT !! NUMBER OF FLOODPLAIN PATH + integer(KIND=JPIM) :: NPTHLEV !! NUMBER OF FLOODPLAIN PATH LAYER + integer(KIND=JPIM),allocatable :: PTH_UPST(:) !! FLOOD PATHWAY UPSTREAM ISEQ + integer(KIND=JPIM),allocatable :: PTH_DOWN(:) !! FLOOD PATHWAY DOWNSTREAM JSEQ + real(KIND=JPRB),allocatable :: PTH_DST(:) !! FLOOD PATHWAY DISTANCE [m] + real(KIND=JPRB),allocatable :: PTH_ELV(:,:) !! FLOOD PATHWAY ELEVATION [m] + real(KIND=JPRB),allocatable :: PTH_WTH(:,:) !! FLOOD PATHWAY WIDTH [m] + real(KIND=JPRB),allocatable :: PTH_MAN(:) !! FLOOD PATHWAY Manning -DATA REGIONALL /1/ -DATA REGIONTHIS /1/ + DATA REGIONALL /1/ + DATA REGIONTHIS /1/ END MODULE YOS_CMF_MAP diff --git a/CaMa/src/yos_cmf_prog.F90 b/CaMa/src/yos_cmf_prog.F90 index 7ba23f59..4fa873c9 100755 --- a/CaMa/src/yos_cmf_prog.F90 +++ b/CaMa/src/yos_cmf_prog.F90 @@ -13,59 +13,59 @@ MODULE YOS_CMF_PROG ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. !========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM, JPRD -IMPLICIT NONE -SAVE -!================================================ -! Pointer was removed in v4.08 in order to keep simple codes when activating Single Precision Mode -!*** prognostics / state variables initial conditions + USE PARKIND1, only: JPIM, JPRB, JPRM, JPRD + IMPLICIT NONE + SAVE + !================================================ + ! Pointer was removed in v4.08 in order to keep simple codes when activating Single Precision Mode + !*** prognostics / state variables initial conditions -! Dammy variable for input/output -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2DAMMY(:,:) !! Dammy Array for unused variables -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2COPY(:,:) !! Dammy Array for Float64/32 switch + ! Dammy variable for input/output + real(KIND=JPRB),allocatable,target :: D2DAMMY(:,:) !! Dammy Array for unused variables + real(KIND=JPRB),allocatable,target :: D2COPY(:,:) !! Dammy Array for Float64/32 switch -!================================================ -!*** input runoff (interporlated) -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2RUNOFF(:,:) !! input runoff [m3/s] -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2ROFSUB(:,:) !! input sub-surface runoff [m3/s] + !================================================ + !*** input runoff (interporlated) + real(KIND=JPRB),allocatable,target :: D2RUNOFF(:,:) !! input runoff [m3/s] + real(KIND=JPRB),allocatable,target :: D2ROFSUB(:,:) !! input sub-surface runoff [m3/s] -!TODO: check d2wevap and d2winfilt units! -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2WEVAP(:,:) !! input Evaporation [m3/s] -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2WINFILT(:,:) !! input Infiltration [m3/s] + !TODO: check d2wevap and d2winfilt units! + real(KIND=JPRB),allocatable,target :: D2WEVAP(:,:) !! input Evaporation [m3/s] + real(KIND=JPRB),allocatable,target :: D2WINFILT(:,:) !! input Infiltration [m3/s] -!================================================ -!*** river & floodpain -! storage variables are always in double precision -REAL(KIND=JPRD),ALLOCATABLE,TARGET :: P2RIVSTO(:,:) !! river storage [m3] -REAL(KIND=JPRD),ALLOCATABLE,TARGET :: P2FLDSTO(:,:) !! floodplain storage [m3] + !================================================ + !*** river & floodpain + ! storage variables are always in double precision + real(KIND=JPRD),allocatable,target :: P2RIVSTO(:,:) !! river storage [m3] + real(KIND=JPRD),allocatable,target :: P2FLDSTO(:,:) !! floodplain storage [m3] -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2RIVOUT(:,:) !! river outflow [m3/s] -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2FLDOUT(:,:) !! floodplain outflow [m3/s] + real(KIND=JPRB),allocatable,target :: D2RIVOUT(:,:) !! river outflow [m3/s] + real(KIND=JPRB),allocatable,target :: D2FLDOUT(:,:) !! floodplain outflow [m3/s] -!================================================ -!*** for implicit schemes of the local inertial equation -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2RIVOUT_PRE(:,:) !! river outflow [m3/s] (prev t-step) -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2RIVDPH_PRE(:,:) !! river depth [m] (prev t-step) -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2FLDOUT_PRE(:,:) !! floodplain outflow [m3/s] (prev t-step) -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2FLDSTO_PRE(:,:) !! floodplain storage [m3] (prev t-step) + !================================================ + !*** for implicit schemes of the local inertial equation + real(KIND=JPRB),allocatable,target :: D2RIVOUT_PRE(:,:) !! river outflow [m3/s] (prev t-step) + real(KIND=JPRB),allocatable,target :: D2RIVDPH_PRE(:,:) !! river depth [m] (prev t-step) + real(KIND=JPRB),allocatable,target :: D2FLDOUT_PRE(:,:) !! floodplain outflow [m3/s] (prev t-step) + real(KIND=JPRB),allocatable,target :: D2FLDSTO_PRE(:,:) !! floodplain storage [m3] (prev t-step) -!================================================ -!*** Groundwater Delay -REAL(KIND=JPRD),ALLOCATABLE,TARGET :: P2GDWSTO(:,:) !! ground water storage [m3] -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D2GDWRTN(:,:) !! Ground water return flow [m3/s] + !================================================ + !*** Groundwater Delay + real(KIND=JPRD),allocatable,target :: P2GDWSTO(:,:) !! ground water storage [m3] + real(KIND=JPRB),allocatable,target :: D2GDWRTN(:,:) !! Ground water return flow [m3/s] -!================================================ -!*** These have a different share, not part of the D2PROG array -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D1PTHFLW(:,:) !! flood path outflow [m3/s] -REAL(KIND=JPRB),ALLOCATABLE,TARGET :: D1PTHFLW_PRE(:,:) !! flood path outflow [m3/s] (prev t-step) + !================================================ + !*** These have a different share, not part of the D2PROG array + real(KIND=JPRB),allocatable,target :: D1PTHFLW(:,:) !! flood path outflow [m3/s] + real(KIND=JPRB),allocatable,target :: D1PTHFLW_PRE(:,:) !! flood path outflow [m3/s] (prev t-step) -!================================================ -!!!*** dam variables -REAL(KIND=JPRD),ALLOCATABLE,TARGET :: P2DAMSTO(:,:) !! reservoir storage [m3] -REAL(KIND=JPRD),ALLOCATABLE,TARGET :: P2DAMINF(:,:) !! reservoir inflow [m3/s]; discharge before operation + !================================================ + !!!*** dam variables + real(KIND=JPRD),allocatable,target :: P2DAMSTO(:,:) !! reservoir storage [m3] + real(KIND=JPRD),allocatable,target :: P2DAMINF(:,:) !! reservoir inflow [m3/s]; discharge before operation -!================================================ -!!!*** levee variables -REAL(KIND=JPRD),ALLOCATABLE,TARGET :: P2LEVSTO(:,:) !! flood storage in protected side (storage betwen river & levee) + !================================================ + !!!*** levee variables + real(KIND=JPRD),allocatable,target :: P2LEVSTO(:,:) !! flood storage in protected side (storage betwen river & levee) END MODULE YOS_CMF_PROG diff --git a/CaMa/src/yos_cmf_time.F90 b/CaMa/src/yos_cmf_time.F90 index 75eb7ad5..68f0dc8a 100755 --- a/CaMa/src/yos_cmf_time.F90 +++ b/CaMa/src/yos_cmf_time.F90 @@ -10,59 +10,59 @@ MODULE YOS_CMF_TIME ! Unless required by applicable law or agreed to in writing, software distributed under the License is ! distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and limitations under the License. -!========================================================== -USE PARKIND1, ONLY: JPIM, JPRB, JPRM -IMPLICIT NONE -!====================================== -SAVE -! simulation time step -INTEGER(KIND=JPIM) :: KSTEP !! time step since start -INTEGER(KIND=JPIM) :: NSTEPS !! total time step (from start to end), given in CMF_TIME_INIT -! elapsed minute from base date (YYYY0,MM0,DD0) -INTEGER(KIND=JPIM) :: KMIN !! KMIN at the start of time step -INTEGER(KIND=JPIM) :: KMINNEXT !! KMIN at the end of time step -! -INTEGER(KIND=JPIM) :: KMINSTART !! KMIN at the start of simulation -INTEGER(KIND=JPIM) :: KMINEND !! KMIN at the end of simulation -! -INTEGER(KIND=JPIM) :: KMINSTAIN !! KMIN at the start of forcing runoff data (netCDF) -INTEGER(KIND=JPIM) :: KMINSTASL !! KMIN at the start of boundary sealev data (netCDF) -! simulation start date:hour (KMINSTART) -INTEGER(KIND=JPIM) :: ISYYYYMMDD !! date at simulation start time -INTEGER(KIND=JPIM) :: ISHHMM !! hour+min at simulation start time -INTEGER(KIND=JPIM) :: ISYYYY -INTEGER(KIND=JPIM) :: ISMM -INTEGER(KIND=JPIM) :: ISDD -INTEGER(KIND=JPIM) :: ISHOUR -INTEGER(KIND=JPIM) :: ISMIN -! simulation end date:hour (KMINEND) -INTEGER(KIND=JPIM) :: IEYYYYMMDD !! date of simulation end time -INTEGER(KIND=JPIM) :: IEHHMM !! hour+min of simulation end time -INTEGER(KIND=JPIM) :: IEYYYY -INTEGER(KIND=JPIM) :: IEMM -INTEGER(KIND=JPIM) :: IEDD -INTEGER(KIND=JPIM) :: IEHOUR -INTEGER(KIND=JPIM) :: IEMIN -!*** date:hour at START of time steop (KMIN) -INTEGER(KIND=JPIM) :: IYYYYMMDD !! date at the start of time-step -INTEGER(KIND=JPIM) :: IYYYY !! year at the start of time-step -INTEGER(KIND=JPIM) :: IMM !! month at the start of time-step -INTEGER(KIND=JPIM) :: IDD !! day at the start of time-step -INTEGER(KIND=JPIM) :: IHHMM !! hour+min at the start of time-step -INTEGER(KIND=JPIM) :: IHOUR !! hour at the start of time-step -INTEGER(KIND=JPIM) :: IMIN !! min at the start of time-step -!*** date:hour at END of time steop (KMINNEXT) -INTEGER(KIND=JPIM) :: JYYYYMMDD !! date at the end of time-step -INTEGER(KIND=JPIM) :: JYYYY !! year at the end of time-step -INTEGER(KIND=JPIM) :: JMM !! month at the end of time-step -INTEGER(KIND=JPIM) :: JDD !! day at the end of time-step -INTEGER(KIND=JPIM) :: JHHMM !! hour+min at the end of time-step -INTEGER(KIND=JPIM) :: JHOUR !! hour at the end of time-step -INTEGER(KIND=JPIM) :: JMIN !! min at the end of time-step + !========================================================== + USE PARKIND1, only: JPIM, JPRB, JPRM + IMPLICIT NONE + !====================================== + SAVE + ! simulation time step + integer(KIND=JPIM) :: KSTEP !! time step since start + integer(KIND=JPIM) :: NSTEPS !! total time step (from start to end), given in CMF_TIME_INIT + ! elapsed minute from base date (YYYY0,MM0,DD0) + integer(KIND=JPIM) :: KMIN !! KMIN at the start of time step + integer(KIND=JPIM) :: KMINNEXT !! KMIN at the end of time step + ! + integer(KIND=JPIM) :: KMINSTART !! KMIN at the start of simulation + integer(KIND=JPIM) :: KMINEND !! KMIN at the end of simulation + ! + integer(KIND=JPIM) :: KMINSTAIN !! KMIN at the start of forcing runoff data (netCDF) + integer(KIND=JPIM) :: KMINSTASL !! KMIN at the start of boundary sealev data (netCDF) + ! simulation start date:hour (KMINSTART) + integer(KIND=JPIM) :: ISYYYYMMDD !! date at simulation start time + integer(KIND=JPIM) :: ISHHMM !! hour+min at simulation start time + integer(KIND=JPIM) :: ISYYYY + integer(KIND=JPIM) :: ISMM + integer(KIND=JPIM) :: ISDD + integer(KIND=JPIM) :: ISHOUR + integer(KIND=JPIM) :: ISMIN + ! simulation end date:hour (KMINEND) + integer(KIND=JPIM) :: IEYYYYMMDD !! date of simulation end time + integer(KIND=JPIM) :: IEHHMM !! hour+min of simulation end time + integer(KIND=JPIM) :: IEYYYY + integer(KIND=JPIM) :: IEMM + integer(KIND=JPIM) :: IEDD + integer(KIND=JPIM) :: IEHOUR + integer(KIND=JPIM) :: IEMIN + !*** date:hour at START of time steop (KMIN) + integer(KIND=JPIM) :: IYYYYMMDD !! date at the start of time-step + integer(KIND=JPIM) :: IYYYY !! year at the start of time-step + integer(KIND=JPIM) :: IMM !! month at the start of time-step + integer(KIND=JPIM) :: IDD !! day at the start of time-step + integer(KIND=JPIM) :: IHHMM !! hour+min at the start of time-step + integer(KIND=JPIM) :: IHOUR !! hour at the start of time-step + integer(KIND=JPIM) :: IMIN !! min at the start of time-step + !*** date:hour at END of time steop (KMINNEXT) + integer(KIND=JPIM) :: JYYYYMMDD !! date at the end of time-step + integer(KIND=JPIM) :: JYYYY !! year at the end of time-step + integer(KIND=JPIM) :: JMM !! month at the end of time-step + integer(KIND=JPIM) :: JDD !! day at the end of time-step + integer(KIND=JPIM) :: JHHMM !! hour+min at the end of time-step + integer(KIND=JPIM) :: JHOUR !! hour at the end of time-step + integer(KIND=JPIM) :: JMIN !! min at the end of time-step -!*** base time to define kmin -INTEGER(KIND=JPIM) :: YYYY0 !! base year -INTEGER(KIND=JPIM) :: MM0 !! base month -INTEGER(KIND=JPIM) :: DD0 !! base day -!========================================================== + !*** base time to define kmin + integer(KIND=JPIM) :: YYYY0 !! base year + integer(KIND=JPIM) :: MM0 !! base month + integer(KIND=JPIM) :: DD0 !! base day + !========================================================== END MODULE YOS_CMF_TIME diff --git a/CaMa/util/igetday.F90 b/CaMa/util/igetday.F90 index 6aecf430..f6a5b69e 100755 --- a/CaMa/util/igetday.F90 +++ b/CaMa/util/igetday.F90 @@ -1,52 +1,52 @@ - program main_igetday +program main_igetday ! ================================================ ! to count number of days in month ! by nhanasaki ! on 20th Dec 2003 ! at IIS,UT ! ================================================ - implicit none +implicit none ! in - integer :: iyear - integer :: imon - integer :: igetday +integer :: iyear +integer :: imon +integer :: igetday - character*8 :: buf +character*8 :: buf ! =============================== - call getarg(1,buf) - read(buf,*) iyear - call getarg(2,buf) - read(buf,*) imon + call getarg(1,buf) + read(buf,*) iyear + call getarg(2,buf) + read(buf,*) imon ! ================================================ ! Calculation for months except February ! ================================================ - if(imon.eq.4.or.imon.eq.6.or.imon.eq.9.or.imon.eq.11)then - igetday=30 - else - igetday=31 - end if + if(imon.eq.4.or.imon.eq.6.or.imon.eq.9.or.imon.eq.11)then + igetday=30 + else + igetday=31 + end if ! ================================================ ! Calculation for February ! ================================================ - if(imon.eq.2)then - if(mod(iyear,4).eq.0)then - igetday=29 - if(mod(iyear,100).eq.0)then + if(imon.eq.2)then + if(mod(iyear,4).eq.0)then + igetday=29 + if(mod(iyear,100).eq.0)then igetday=28 if(mod(iyear,400).eq.0)then - igetday=29 + igetday=29 end if - end if - else - igetday=28 - end if + end if + else + igetday=28 end if + end if ! fix - if(iyear.eq.0.and.imon.eq.2)then - igetday=28 - end if + if(iyear.eq.0.and.imon.eq.2)then + igetday=28 + end if - print *, igetday + print *, igetday ! - end program main_igetday +end program main_igetday diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 471369ba..1b453c34 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -38,133 +38,133 @@ MODULE MOD_LeafInterception IMPLICIT NONE - REAL(r8), parameter :: CICE = 2.094E06 !specific heat capacity of ice (j/m3/k) - REAL(r8), parameter :: bp = 20. - REAL(r8), parameter :: HFUS = 0.3336E06 !latent heat of fusion (j/kg) - REAL(r8), parameter :: CWAT = 4.188E06 !specific heat capacity of water (j/m3/k) - REAL(r8), parameter :: pcoefs(2,2) = reshape((/20.0_r8, 0.206e-8_r8, 0.0001_r8, 0.9999_r8/), (/2,2/)) + real(r8), parameter :: CICE = 2.094E06 !specific heat capacity of ice (j/m3/k) + real(r8), parameter :: bp = 20. + real(r8), parameter :: HFUS = 0.3336E06 !latent heat of fusion (j/kg) + real(r8), parameter :: CWAT = 4.188E06 !specific heat capacity of water (j/m3/k) + real(r8), parameter :: pcoefs(2,2) = reshape((/20.0_r8, 0.206e-8_r8, 0.0001_r8, 0.9999_r8/), (/2,2/)) !----------------------- Dummy argument -------------------------------- - REAL(r8) :: satcap ! maximum allowed water on canopy [mm] - REAL(r8) :: satcap_rain ! maximum allowed rain on canopy [mm] - REAL(r8) :: satcap_snow ! maximum allowed snow on canopy [mm] - REAL(r8) :: lsai ! sum of leaf area index and stem area index [-] - REAL(r8) :: chiv ! leaf angle distribution factor - REAL(r8) :: ppc ! convective precipitation in time-step [mm] - REAL(r8) :: ppl ! large-scale precipitation in time-step [mm] - REAL(r8) :: p0 ! precipitation in time-step [mm] - REAL(r8) :: fpi ! coefficient of interception - REAL(r8) :: fpi_rain ! coefficient of interception of rain - REAL(r8) :: fpi_snow ! coefficient of interception of snow - REAL(r8) :: alpha_rain ! coefficient of interception of rain - REAL(r8) :: alpha_snow ! coefficient of interception of snow - REAL(r8) :: pinf ! interception of precipitation in time step [mm] - REAL(r8) :: tti_rain ! direct rain throughfall in time step [mm] - REAL(r8) :: tti_snow ! direct snow throughfall in time step [mm] - REAL(r8) :: tex_rain ! canopy rain drainage in time step [mm] - REAL(r8) :: tex_snow ! canopy snow drainage in time step [mm] - REAL(r8) :: vegt ! sigf*lsai - REAL(r8) :: xs ! proportion of the grid area where the intercepted rainfall + real(r8) :: satcap ! maximum allowed water on canopy [mm] + real(r8) :: satcap_rain ! maximum allowed rain on canopy [mm] + real(r8) :: satcap_snow ! maximum allowed snow on canopy [mm] + real(r8) :: lsai ! sum of leaf area index and stem area index [-] + real(r8) :: chiv ! leaf angle distribution factor + real(r8) :: ppc ! convective precipitation in time-step [mm] + real(r8) :: ppl ! large-scale precipitation in time-step [mm] + real(r8) :: p0 ! precipitation in time-step [mm] + real(r8) :: fpi ! coefficient of interception + real(r8) :: fpi_rain ! coefficient of interception of rain + real(r8) :: fpi_snow ! coefficient of interception of snow + real(r8) :: alpha_rain ! coefficient of interception of rain + real(r8) :: alpha_snow ! coefficient of interception of snow + real(r8) :: pinf ! interception of precipitation in time step [mm] + real(r8) :: tti_rain ! direct rain throughfall in time step [mm] + real(r8) :: tti_snow ! direct snow throughfall in time step [mm] + real(r8) :: tex_rain ! canopy rain drainage in time step [mm] + real(r8) :: tex_snow ! canopy snow drainage in time step [mm] + real(r8) :: vegt ! sigf*lsai + real(r8) :: xs ! proportion of the grid area where the intercepted rainfall ! plus the preexisting canopy water storage - REAL(r8) :: unl_snow_temp,U10,unl_snow_wind,unl_snow - REAL(r8) :: ap, cp, aa1, bb1, exrain, arg, w - REAL(r8) :: thru_rain, thru_snow - REAL(r8) :: xsc_rain, xsc_snow + real(r8) :: unl_snow_temp,U10,unl_snow_wind,unl_snow + real(r8) :: ap, cp, aa1, bb1, exrain, arg, w + real(r8) :: thru_rain, thru_snow + real(r8) :: xsc_rain, xsc_snow - REAL(r8) :: fvegc !vegetation fraction - REAL(r8) :: FT !The temperature factor for snow unloading - REAL(r8) :: FV !The wind factor for snow unloading - REAL(r8) :: ICEDRIP ! snow unloading + real(r8) :: fvegc ! vegetation fraction + real(r8) :: FT ! the temperature factor for snow unloading + real(r8) :: FV ! the wind factor for snow unloading + real(r8) :: ICEDRIP ! snow unloading - REAL(r8) :: ldew_smelt - REAL(r8) :: ldew_frzc - REAL(r8) :: FP - REAL(r8) :: int_rain - REAL(r8) :: int_snow + real(r8) :: ldew_smelt + real(r8) :: ldew_frzc + real(r8) :: FP + real(r8) :: int_rain + real(r8) :: int_snow - REAL(r8) :: qflx_irrig_drip - REAL(r8) :: qflx_irrig_sprinkler - REAL(r8) :: qflx_irrig_flood - REAL(r8) :: qflx_irrig_paddy + real(r8) :: qflx_irrig_drip + real(r8) :: qflx_irrig_sprinkler + real(r8) :: qflx_irrig_flood + real(r8) :: qflx_irrig_paddy -contains +CONTAINS SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) - !DESCRIPTION - !=========== - ! Calculation of interception and drainage of precipitation - ! the treatment are based on Sellers et al. (1996) +!DESCRIPTION +!=========== + ! Calculation of interception and drainage of precipitation + ! the treatment are based on Sellers et al. (1996) - !Original Author: - !------------------- - !canopy interception scheme modified by Yongjiu Dai based on Sellers et al. (1996) +!Original Author: +!------------------- + !canopy interception scheme modified by Yongjiu Dai based on Sellers et al. (1996) - !References: - !------------------- - !---Dai, Y., Zeng, X., Dickinson, R.E., Baker, I., Bonan, G.B., BosiloVICh, M.G., Denning, A.S., - ! Dirmeyer, P.A., Houser, P.R., Niu, G. and Oleson, K.W., 2003. - ! The common land model. Bulletin of the American Meteorological Society, 84(8), pp.1013-1024. +!References: +!------------------- + !---Dai, Y., Zeng, X., Dickinson, R.E., Baker, I., Bonan, G.B., BosiloVICh, M.G., Denning, A.S., + ! Dirmeyer, P.A., Houser, P.R., Niu, G. and Oleson, K.W., 2003. + ! The common land model. Bulletin of the American Meteorological Society, 84(8), pp.1013-1024. - !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. - ! The partitioning of evapotranspiration into transpiration, soil evaporation, - ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. + !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. + ! The partitioning of evapotranspiration into transpiration, soil evaporation, + ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. - !---Oleson, K., Dai, Y., Bonan, B., BosiloVIChm, M., Dickinson, R., Dirmeyer, P., Hoffman, - ! F., Houser, P., Levis, S., Niu, G.Y. and Thornton, P., 2004. - ! Technical description of the community land model (CLM). + !---Oleson, K., Dai, Y., Bonan, B., BosiloVIChm, M., Dickinson, R., Dirmeyer, P., Hoffman, + ! F., Houser, P., Levis, S., Niu, G.Y. and Thornton, P., 2004. + ! Technical description of the community land model (CLM). - !---Sellers, P.J., Randall, D.A., Collatz, G.J., Berry, J.A., Field, C.B., Dazlich, D.A., Zhang, C., - ! Collelo, G.D. and Bounoua, L., 1996. A revised land surface parameterization (SiB2) for atmospheric GCMs. - ! Part I: Model formulation. Journal of climate, 9(4), pp.676-705. + !---Sellers, P.J., Randall, D.A., Collatz, G.J., Berry, J.A., Field, C.B., Dazlich, D.A., Zhang, C., + ! Collelo, G.D. and Bounoua, L., 1996. A revised land surface parameterization (SiB2) for atmospheric GCMs. + ! Part I: Model formulation. Journal of climate, 9(4), pp.676-705. - !---Sellers, P.J., Tucker, C.J., Collatz, G.J., Los, S.O., Justice, C.O., Dazlich, D.A. and Randall, D.A., 1996. - ! A revised land surface parameterization (SiB2) for atmospheric GCMs. Part II: - ! The generation of global fields of terrestrial biophysical parameters from satellite data. - ! Journal of climate, 9(4), pp.706-737. + !---Sellers, P.J., Tucker, C.J., Collatz, G.J., Los, S.O., Justice, C.O., Dazlich, D.A. and Randall, D.A., 1996. + ! A revised land surface parameterization (SiB2) for atmospheric GCMs. Part II: + ! The generation of global fields of terrestrial biophysical parameters from satellite data. + ! Journal of climate, 9(4), pp.706-737. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - !---2023.02.21 Zhongwang Wei @ SYSU : Snow and rain interception - !---2021.12.08 Zhongwang Wei @ SYSU - !---2019.06 Hua Yuan: remove sigf and USE lai+sai for judgement. - !---2014.04 Yongjiu Dai - !---2002.08.31 Yongjiu Dai - !======================================================================= +!REVISION HISTORY +!---------------- + !---2023.02.21 Zhongwang Wei @ SYSU : Snow and rain interception + !---2021.12.08 Zhongwang Wei @ SYSU + !---2019.06 Hua Yuan: remove sigf and USE lai+sai for judgement. + !---2014.04 Yongjiu Dai + !---2002.08.31 Yongjiu Dai +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim ! seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx ! maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us ! wind speed - REAL(r8), INTENT(in) :: forc_vs ! wind speed - REAL(r8), INTENT(in) :: chil ! leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain ! convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow ! convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain ! large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow ! large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai ! leaf area index [-] - REAL(r8), INTENT(in) :: sai ! stem area index [-] - REAL(r8), INTENT(in) :: tair ! air temperature [K] - REAL(r8), INTENT(in) :: tleaf ! sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew ! depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain ! depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow ! depth of water on foliage [mm] - REAL(r8), INTENT(in) :: z0m ! roughness length - REAL(r8), INTENT(in) :: hu ! forcing height of U - - REAL(r8), INTENT(out) :: pg_rain ! rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow ! snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr ! interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim ! seconds in a time step [second] + real(r8), intent(in) :: dewmx ! maximum dew [mm] + real(r8), intent(in) :: forc_us ! wind speed + real(r8), intent(in) :: forc_vs ! wind speed + real(r8), intent(in) :: chil ! leaf angle distribution factor + real(r8), intent(in) :: prc_rain ! convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow ! convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain ! large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow ! large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai ! leaf area index [-] + real(r8), intent(in) :: sai ! stem area index [-] + real(r8), intent(in) :: tair ! air temperature [K] + real(r8), intent(in) :: tleaf ! sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew ! depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain ! depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow ! depth of water on foliage [mm] + real(r8), intent(in) :: z0m ! roughness length + real(r8), intent(in) :: hu ! forcing height of U + + real(r8), intent(out) :: pg_rain ! rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow ! snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr ! interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -294,58 +294,58 @@ SUBROUTINE LEAF_interception_CoLM202x (deltim,dewmx,forc_us,forc_vs,chil,sigf,la prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,& qintr,qintr_rain,qintr_snow) - !DESCRIPTION - !=========== - ! Calculation of interception and drainage of precipitation (under development) - ! the scheme developed by Zhongwang wei @ SYSU (not finished yet) +!DESCRIPTION +!=========== + ! Calculation of interception and drainage of precipitation (under development) + ! the scheme developed by Zhongwang wei @ SYSU (not finished yet) - !Original Author: - !------------------- - !---Zhongwang Wei @ SYSU +!Original Author: +!------------------- + !---Zhongwang Wei @ SYSU - !References: - !------------------- - !---Zhong, F., Jiang, S., van Dijk, A.I., Ren, L., Schellekens, J. and Miralles, D.G., 2022. - ! Revisiting large-scale interception patterns constrained by a synthesis of global experimental - ! data. Hydrology and Earth System Sciences, 26(21), pp.5647-5667. - !--- +!References: +!------------------- + !---Zhong, F., Jiang, S., van Dijk, A.I., Ren, L., Schellekens, J. and Miralles, D.G., 2022. + ! Revisiting large-scale interception patterns constrained by a synthesis of global experimental + ! data. Hydrology and Earth System Sciences, 26(21), pp.5647-5667. + !--- - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - !---2023.04.30 Zhongwang Wei @ SYSU : Snow and rain interception - !======================================================================= +!REVISION HISTORY +!---------------- + !---2023.04.30 Zhongwang Wei @ SYSU : Snow and rain interception +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim ! seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx ! maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us ! wind speed - REAL(r8), INTENT(in) :: forc_vs ! wind speed - REAL(r8), INTENT(in) :: chil ! leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain ! convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow ! convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain ! large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow ! large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai ! leaf area index [-] - REAL(r8), INTENT(in) :: sai ! stem area index [-] - REAL(r8), INTENT(in) :: tair ! air temperature [K] - REAL(r8), INTENT(in) :: tleaf ! sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew ! depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain ! depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow ! depth of water on foliage [mm] - REAL(r8), INTENT(in) :: z0m ! roughness length - REAL(r8), INTENT(in) :: hu ! forcing height of U - - REAL(r8), INTENT(out) :: pg_rain ! rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow ! snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr ! interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim ! seconds in a time step [second] + real(r8), intent(in) :: dewmx ! maximum dew [mm] + real(r8), intent(in) :: forc_us ! wind speed + real(r8), intent(in) :: forc_vs ! wind speed + real(r8), intent(in) :: chil ! leaf angle distribution factor + real(r8), intent(in) :: prc_rain ! convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow ! convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain ! large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow ! large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai ! leaf area index [-] + real(r8), intent(in) :: sai ! stem area index [-] + real(r8), intent(in) :: tair ! air temperature [K] + real(r8), intent(in) :: tleaf ! sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew ! depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain ! depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow ! depth of water on foliage [mm] + real(r8), intent(in) :: z0m ! roughness length + real(r8), intent(in) :: hu ! forcing height of U + + real(r8), intent(out) :: pg_rain ! rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow ! snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr ! interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -473,60 +473,60 @@ SUBROUTINE LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - !DESCRIPTION - !=========== - ! Interception and drainage of precipitation - ! the treatment are modified from CLM4.5 +!DESCRIPTION +!=========== + ! Interception and drainage of precipitation + ! the treatment are modified from CLM4.5 - !Original Author: - !------------------- - !Lawrence, D.M. +!Original Author: +!------------------- + !Lawrence, D.M. - !References: - !------------------- - !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. - ! The partitioning of evapotranspiration into transpiration, soil evaporation, - ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. +!References: +!------------------- + !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. + ! The partitioning of evapotranspiration into transpiration, soil evaporation, + ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - ! 2023.02.21 Zhongwang Wei @ SYSU : Snow and rain interception - ! 2021.12.08 Zhongwang Wei @ SYSU - ! 2014.04 Yongjiu Dai - ! 2002.08.31 Yongjiu Dai - !======================================================================= +!REVISION HISTORY +!---------------- + ! 2023.02.21 Zhongwang Wei @ SYSU : Snow and rain interception + ! 2021.12.08 Zhongwang Wei @ SYSU + ! 2014.04 Yongjiu Dai + ! 2002.08.31 Yongjiu Dai +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(in) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of water on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -631,67 +631,67 @@ SUBROUTINE LEAF_interception_CLM5 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,& qintr,qintr_rain,qintr_snow) - !DESCRIPTION - !=========== - ! Interception and drainage of precipitation - ! the treatment are modified from CLM5.0 +!DESCRIPTION +!=========== + ! Interception and drainage of precipitation + ! the treatment are modified from CLM5.0 - !Original Author: - !------------------- - !---Lawrence, D.M. +!Original Author: +!------------------- + !---Lawrence, D.M. - !References: - !------------------- - !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. - ! The partitioning of evapotranspiration into transpiration, soil evaporation, - ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. - !---Lawrence, D.M., Fisher, R.A., Koven, C.D., Oleson, K.W., Swenson, S.C., Bonan, G., Collier, N., Ghimire, B., - ! van Kampenhout, L., Kennedy, D. and Kluzek, E., 2019. The Community Land Model version 5: - ! Description of new features, benchmarking, and impact of forcing uncertainty. - ! Journal of Advances in Modeling Earth Systems, 11(12), pp.4245-4287. - !---Fan, Y., Meijide, A., Lawrence, D.M., Roupsard, O., Carlson, K.M., Chen, H.Y., - ! Röll, A., Niu, F. and Knohl, A., 2019. Reconciling canopy interception parameterization - ! and rainfall forcing frequency in the Community Land Model for simulating evapotranspiration - ! of rainforests and oil palm plantations in Indonesia. Journal of Advances in Modeling Earth Systems, 11(3), pp.732-751. +!References: +!------------------- + !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. + ! The partitioning of evapotranspiration into transpiration, soil evaporation, + ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. + !---Lawrence, D.M., Fisher, R.A., Koven, C.D., Oleson, K.W., Swenson, S.C., Bonan, G., Collier, N., Ghimire, B., + ! van Kampenhout, L., Kennedy, D. and Kluzek, E., 2019. The Community Land Model version 5: + ! Description of new features, benchmarking, and impact of forcing uncertainty. + ! Journal of Advances in Modeling Earth Systems, 11(12), pp.4245-4287. + !---Fan, Y., Meijide, A., Lawrence, D.M., Roupsard, O., Carlson, K.M., Chen, H.Y., + ! Röll, A., Niu, F. and Knohl, A., 2019. Reconciling canopy interception parameterization + ! and rainfall forcing frequency in the Community Land Model for simulating evapotranspiration + ! of rainforests and oil palm plantations in Indonesia. Journal of Advances in Modeling Earth Systems, 11(3), pp.732-751. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - ! 2023.02.21 Zhongwang Wei @ SYSU - ! 2021.12.08 Zhongwang Wei @ SYSU - !======================================================================= +!REVISION HISTORY +!---------------- + ! 2023.02.21 Zhongwang Wei @ SYSU + ! 2021.12.08 Zhongwang Wei @ SYSU +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(in) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of water on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -805,66 +805,66 @@ END SUBROUTINE LEAF_interception_CLM5 SUBROUTINE LEAF_interception_NOAHMP(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) - !DESCRIPTION - !=========== - ! Interception and drainage of precipitation - ! the treatment are modified from Noah-MP 5.0 +!DESCRIPTION +!=========== + ! Interception and drainage of precipitation + ! the treatment are modified from Noah-MP 5.0 - !Original Author: - !------------------- - !---Guo-Yue Niu +!Original Author: +!------------------- + !---Guo-Yue Niu - !References: - !------------------- - !---Yang, M., Zuo, R., Li, X. and Wang, L., 2019. Improvement test for the canopy interception parameterization scheme - ! in the community land model. Sola, 15, pp.166-171. - !---Niu, G.Y., Yang, Z.L., Mitchell, K.E., Chen, F., Ek, M.B., Barlage, M., Kumar, A., - ! Manning, K., Niyogi, D., Rosero, E. and Tewari, M., 2011. The community Noah land - ! surface model with multiparameterization options (Noah‐MP): 1. Model description and evaluation - ! with local‐scale measurements. Journal of Geophysical Research: Atmospheres, 116(D12). - !---He, C., Valayamkunnath, P., Barlage, M., Chen, F., Gochis, D., Cabell, R., Schneider, T., - ! Rasmussen, R., Niu, G.Y., Yang, Z.L. and Niyogi, D., 2023. Modernizing the open-source - ! community Noah-MP land surface model (version 5.0) with enhanced modularity, - ! interoperability, and applicability. EGUsphere, 2023, pp.1-31. +!References: +!------------------- + !---Yang, M., Zuo, R., Li, X. and Wang, L., 2019. Improvement test for the canopy interception parameterization scheme + ! in the community land model. Sola, 15, pp.166-171. + !---Niu, G.Y., Yang, Z.L., Mitchell, K.E., Chen, F., Ek, M.B., Barlage, M., Kumar, A., + ! Manning, K., Niyogi, D., Rosero, E. and Tewari, M., 2011. The community Noah land + ! surface model with multiparameterization options (Noah‐MP): 1. Model description and evaluation + ! with local‐scale measurements. Journal of Geophysical Research: Atmospheres, 116(D12). + !---He, C., Valayamkunnath, P., Barlage, M., Chen, F., Gochis, D., Cabell, R., Schneider, T., + ! Rasmussen, R., Niu, G.Y., Yang, Z.L. and Niyogi, D., 2023. Modernizing the open-source + ! community Noah-MP land surface model (version 5.0) with enhanced modularity, + ! interoperability, and applicability. EGUsphere, 2023, pp.1-31. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - ! 2023.02.21 Zhongwang Wei @ SYSU - ! 2021.12.08 Zhongwang Wei @ SYSU - !======================================================================= +!REVISION HISTORY +!---------------- + ! 2023.02.21 Zhongwang Wei @ SYSU + ! 2021.12.08 Zhongwang Wei @ SYSU +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(inout) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of liquid on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of liquid on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) - REAL(r8) :: BDFALL + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8) :: BDFALL IF (lai+sai > 1e-6) THEN lsai = lai + sai vegt = lsai @@ -1006,66 +1006,66 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,qintr,& qintr_rain,qintr_snow) - !DESCRIPTION - !=========== - ! Interception and drainage of precipitation - ! the treatment are modified from MATSIRO 6 (under development) +!DESCRIPTION +!=========== + ! Interception and drainage of precipitation + ! the treatment are modified from MATSIRO 6 (under development) - !Original Author: - !------------------- - !---MATSIRO6 document writing team∗ +!Original Author: +!------------------- + !---MATSIRO6 document writing team∗ - !References: - !------------------- - !---Tatebe, H., Ogura, T., Nitta, T., Komuro, Y., Ogochi, K., Takemura, T., Sudo, K., Sekiguchi, M., - ! Abe, M., Saito, F. and Chikira, M., 2019. Description and basic evaluation of simulated mean state, - ! internal variability, and climate sensitivity in MIROC6. Geoscientific Model Development, 12(7), pp.2727-2765. 116(D12). - !---Takata, K., Emori, S. and Watanabe, T., 2003. Development of the minimal advanced treatments of surface interaction and - ! runoff. Global and planetary Change, 38(1-2), pp.209-222. - !---Guo, Q., Kino, K., Li, S., Nitta, T., Takeshima, A., Suzuki, K.T., Yoshida, N. and Yoshimura, K., 2021. - ! Description of MATSIRO6. +!References: +!------------------- + !---Tatebe, H., Ogura, T., Nitta, T., Komuro, Y., Ogochi, K., Takemura, T., Sudo, K., Sekiguchi, M., + ! Abe, M., Saito, F. and Chikira, M., 2019. Description and basic evaluation of simulated mean state, + ! internal variability, and climate sensitivity in MIROC6. Geoscientific Model Development, 12(7), pp.2727-2765. 116(D12). + !---Takata, K., Emori, S. and Watanabe, T., 2003. Development of the minimal advanced treatments of surface interaction and + ! runoff. Global and planetary Change, 38(1-2), pp.209-222. + !---Guo, Q., Kino, K., Li, S., Nitta, T., Takeshima, A., Suzuki, K.T., Yoshida, N. and Yoshimura, K., 2021. + ! Description of MATSIRO6. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - ! 2023.02.21 Zhongwang Wei @ SYSU - ! 2021.12.08 Zhongwang Wei @ SYSU - !======================================================================= +!REVISION HISTORY +!---------------- + ! 2023.02.21 Zhongwang Wei @ SYSU + ! 2021.12.08 Zhongwang Wei @ SYSU +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(inout) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of liquid on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of liquid on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) - !local - REAL(r8) :: fint, Ac, dewmx_MATSIRO,ldew_rain_s, ldew_snow_s,ldew_rain_n, ldew_snow_n - REAL(r8) :: tex_rain_n,tex_rain_s,tex_snow_n,tex_snow_s,tti_rain_n,tti_rain_s,tti_snow_n,tti_snow_s + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + !local + real(r8) :: fint, Ac, dewmx_MATSIRO,ldew_rain_s, ldew_snow_s,ldew_rain_n, ldew_snow_n + real(r8) :: tex_rain_n,tex_rain_s,tex_snow_n,tex_snow_s,tti_rain_n,tti_rain_s,tti_snow_n,tti_snow_s !the canopy water capacity per leaf area index is set to 0.2mm dewmx_MATSIRO = 0.2 @@ -1136,8 +1136,6 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai tex_snow_s = min(tex_snow_s, ldew_snow_s) ldew_snow_s = ldew_snow_s - tex_snow_s - - !------------------------------------------------------------------------- ! Non-storm area !------------------------------------------------------------------------- @@ -1158,8 +1156,6 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai tex_snow_n = min(tex_snow_n, ldew_snow_n) ldew_snow_n = ldew_snow_n - tex_snow_n !------------------------------------------------------------------------- - - !------------------------------------------------------------------------- ! Average !------------------------------------------------------------------------- @@ -1249,70 +1245,69 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) +!DESCRIPTION +!=========== + ! Calculation of interception and drainage of precipitation + ! the treatment are based on VIC 5.0 (under development) - !DESCRIPTION - !=========== - ! Calculation of interception and drainage of precipitation - ! the treatment are based on VIC 5.0 (under development) - - !Original Author: - !------------------- - !---Hamman, J.J. AND Liang X. +!Original Author: +!------------------- + !---Hamman, J.J. AND Liang X. - !References: - !------------------- - !---Hamman, J.J., Nijssen, B., Bohn, T.J., Gergel, D.R. and Mao, Y., 2018. - ! The Variable Infiltration Capacity model version 5 (VIC-5): Infrastructure - ! improvements for new applications and reproducibility. Geoscientific Model Development, - ! 11(8), pp.3481-3496. - !---Liang, X., Lettenmaier, D.P., Wood, E.F. and Burges, S.J., 1994. - ! A simple hydrologically based model of land surface water and energy fluxes - ! for general circulation models. Journal of Geophysical Research: Atmospheres, 99(D7), - ! pp.14415-14428. +!References: +!------------------- + !---Hamman, J.J., Nijssen, B., Bohn, T.J., Gergel, D.R. and Mao, Y., 2018. + ! The Variable Infiltration Capacity model version 5 (VIC-5): Infrastructure + ! improvements for new applications and reproducibility. Geoscientific Model Development, + ! 11(8), pp.3481-3496. + !---Liang, X., Lettenmaier, D.P., Wood, E.F. and Burges, S.J., 1994. + ! A simple hydrologically based model of land surface water and energy fluxes + ! for general circulation models. Journal of Geophysical Research: Atmospheres, 99(D7), + ! pp.14415-14428. - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !REVISION HISTORY - !---------------- - ! 2023.02.21 Zhongwang Wei @ SYSU - ! 2021.12.08 Zhongwang Wei @ SYSU - !======================================================================= +!REVISION HISTORY +!---------------- + ! 2023.02.21 Zhongwang Wei @ SYSU + ! 2021.12.08 Zhongwang Wei @ SYSU +!======================================================================= - IMPLICIT NONE + IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(inout) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of liquid on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of liquid on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) - - real(r8) :: Imax1,Lr,ldew_max_snow,Snow,Rain,DeltaSnowInt,Wind,BlownSnow,SnowThroughFall - real(r8) :: MaxInt,MaxWaterInt,RainThroughFall,Overload,IntRainFract,IntSnowFract,ldew_smelt - real(r8) :: drip + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + + real(r8) :: Imax1,Lr,ldew_max_snow,Snow,Rain,DeltaSnowInt,Wind,BlownSnow,SnowThroughFall + real(r8) :: MaxInt,MaxWaterInt,RainThroughFall,Overload,IntRainFract,IntSnowFract,ldew_smelt + real(r8) :: drip IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -1320,13 +1315,13 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai !the maximum bearing capacity of the tree regardless of air temp (Imax1) Imax1=4.0*lsai*0.0005 *1000.0 ! in mm MaxInt=0.1*lsai - if (tair>-272.15) THEN + IF (tair>-272.15) THEN Lr=4.0 ELSE IF (tair<=-272.15 .and. tair>=-270.15) THEN Lr=1.5*(tair-273.15)+5.5 - else + ELSE Lr=1.0 - endif + ENDIF satcap_snow=0.0005 *Lr *lsai * 1000.0 ! in mm !!! !/* Calculate amount of snow intercepted on branches and stored in intercepted snow. */ @@ -1396,12 +1391,12 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai !cold (< -3 to -5 C). !Schmidt and Troendle 1992 western snow conference paper. */ Wind= SQRT(forc_us*forc_us + forc_vs*forc_vs) - if (tleaf-273.15<-3.0 .and. Wind> 1.0) THEN + IF (tleaf-273.15<-3.0 .and. Wind> 1.0) THEN BlownSnow=(0.2*Wind -0.2)* ldew_snow BlownSnow = min(ldew_snow,BlownSnow) tex_snow = tex_snow + BlownSnow ldew_snow = ldew_snow - BlownSnow - endif + ENDIF !/* at this point we have calculated the amount of snowfall intercepted and !/* the amount of rainfall intercepted. These values have been !/* appropriately subtracted from SnowFall and RainFall to determine @@ -1482,7 +1477,6 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai qintr = 0. qintr_rain = 0. qintr_snow = 0. - ENDIF END SUBROUTINE LEAF_interception_VIC @@ -1516,33 +1510,33 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa IMPLICIT NONE - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(inout) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of liquid on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of liquid on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) - REAL(r8) :: snowinterceptfact,unload_rate_cnst,unload_rate_u,Wind + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8) :: snowinterceptfact,unload_rate_cnst,unload_rate_u,Wind IF (lai+sai > 1e-6) THEN lsai = lai + sai vegt = lsai @@ -1575,12 +1569,12 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa !something wrong with this part in JULES, need to be checked ! IF (ldew_snow>1.e-8) THEN ! Wind= SQRT(forc_us*forc_us + forc_vs*forc_vs) -! if (Wind > 1.0) THEN +! IF (Wind > 1.0) THEN ! ICEDRIP = unload_rate_cnst + unload_rate_u * Wind ! ICEDRIP = MIN(ICEDRIP,ldew_snow) ! xsc_snow = xsc_snow+ICEDRIP ! ldew_snow = ldew_snow - ICEDRIP -! endif +! ENDIF ! ENDIF ! phase change and excess ! @@ -1654,7 +1648,7 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa ENDIF #endif ELSE - ! 07/15/2023, yuan: #bug found for ldew value reset. + ! 07/15/2023, yuan: #bug found for ldew value reset. !NOTE: this bug should exist in other interception schemes @Zhongwang. IF (ldew > 0.) THEN IF (tleaf > tfrz) THEN @@ -1673,7 +1667,6 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa qintr = 0. qintr_rain = 0. qintr_snow = 0. - ENDIF END SUBROUTINE LEAF_interception_JULES @@ -1681,100 +1674,97 @@ SUBROUTINE LEAF_interception_wrap(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - !DESCRIPTION - !=========== +!DESCRIPTION +!=========== !wrapper for calculation of canopy interception using USGS or IGBP land cover classification - !ANCILLARY FUNCTIONS AND SUBROUTINES - !------------------- +!ANCILLARY FUNCTIONS AND SUBROUTINES +!------------------- - !Original Author: - !------------------- - !---Shupeng Zhang +!Original Author: +!------------------- + !---Shupeng Zhang - !References: +!References: - !REVISION HISTORY - !---------------- - - IMPLICIT NONE +!REVISION HISTORY +!---------------- - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: chil !leaf angle distribution factor - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - REAL(r8), INTENT(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - REAL(r8), INTENT(in) :: lai !leaf area index [-] - REAL(r8), INTENT(in) :: sai !stem area index [-] - REAL(r8), INTENT(in) :: tair !air temperature [K] - REAL(r8), INTENT(inout) :: tleaf !sunlit canopy leaf temperature [K] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_rain !depth of liquid on foliage [mm] - REAL(r8), INTENT(inout) :: ldew_snow !depth of liquid on foliage [mm] - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - - - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain ! rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow ! snowfall interception (mm h2o/s) - - - IF (DEF_Interception_scheme==1) then + IMPLICIT NONE + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + + IF (DEF_Interception_scheme==1) THEN CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - - ELSEIF (DEF_Interception_scheme==2) then + ELSEIF (DEF_Interception_scheme==2) THEN CALL LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - ELSEIF (DEF_Interception_scheme==3) then + ELSEIF (DEF_Interception_scheme==3) THEN CALL LEAF_interception_CLM5(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - ELSEIF (DEF_Interception_scheme==4) then + ELSEIF (DEF_Interception_scheme==4) THEN CALL LEAF_interception_NoahMP (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - ELSEIF (DEF_Interception_scheme==5) then + ELSEIF (DEF_Interception_scheme==5) THEN CALL LEAF_interception_matsiro (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - ELSEIF (DEF_Interception_scheme==6) then + ELSEIF (DEF_Interception_scheme==6) THEN CALL LEAF_interception_vic (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - ELSEIF (DEF_Interception_scheme==7) then + ELSEIF (DEF_Interception_scheme==7) THEN CALL LEAF_interception_JULES (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - ELSEIF (DEF_Interception_scheme==8) then + ELSEIF (DEF_Interception_scheme==8) THEN CALL LEAF_interception_colm202x (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) - endif + ENDIF END SUBROUTINE LEAF_interception_wrap @@ -1794,42 +1784,42 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t ! ! ----------------------------------------------------------------- - USE MOD_Precision - USE MOD_LandPFT - USE MOD_Const_Physical, only: tfrz - USE MOD_Vars_PFTimeInvariants - USE MOD_Vars_PFTimeVariables - USE MOD_Vars_1DPFTFluxes - USE MOD_Const_PFT - IMPLICIT NONE + USE MOD_Precision + USE MOD_LandPFT + USE MOD_Const_Physical, only: tfrz + USE MOD_Vars_PFTimeInvariants + USE MOD_Vars_PFTimeVariables + USE MOD_Vars_1DPFTFluxes + USE MOD_Const_PFT + IMPLICIT NONE - INTEGER, INTENT(in) :: ipatch !patch index - REAL(r8), INTENT(in) :: deltim !seconds in a time step [second] - REAL(r8), INTENT(in) :: dewmx !maximum dew [mm] - REAL(r8), INTENT(in) :: forc_us !wind speed - REAL(r8), INTENT(in) :: forc_vs !wind speed - REAL(r8), INTENT(in) :: forc_t !air temperature - REAL(r8), INTENT(in) :: z0m !roughness length - REAL(r8), INTENT(in) :: hu !forcing height of U - REAL(r8), INTENT(in) :: ldew_rain !depth of water on foliage [mm] - REAL(r8), INTENT(in) :: ldew_snow !depth of water on foliage [mm] - REAL(r8), INTENT(in) :: prc_rain !convective ranfall [mm/s] - REAL(r8), INTENT(in) :: prc_snow !convective snowfall [mm/s] - REAL(r8), INTENT(in) :: prl_rain !large-scale rainfall [mm/s] - REAL(r8), INTENT(in) :: prl_snow !large-scale snowfall [mm/s] - - REAL(r8), INTENT(inout) :: ldew !depth of water on foliage [mm] - REAL(r8), INTENT(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr !interception [kg/(m2 s)] - REAL(r8), INTENT(out) :: qintr_rain !rainfall interception (mm h2o/s) - REAL(r8), INTENT(out) :: qintr_snow !snowfall interception (mm h2o/s) - - INTEGER i, p, ps, pe + integer, intent(in) :: ipatch !patch index + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: forc_t !air temperature + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + real(r8), intent(in) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(in) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) + + integer i, p, ps, pe #ifdef CROP - INTEGER :: irrig_flag ! 1 if sprinker, 2 if others + integer :: irrig_flag ! 1 if sprinker, 2 if others #endif - REAL(r8) pg_rain_tmp, pg_snow_tmp + real(r8) pg_rain_tmp, pg_snow_tmp pg_rain_tmp = 0. pg_snow_tmp = 0. @@ -1837,15 +1827,15 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t ps = patch_pft_s(ipatch) pe = patch_pft_e(ipatch) - if(.not. DEF_USE_IRRIGATION) qflx_irrig_sprinkler = 0._r8 + IF(.not. DEF_USE_IRRIGATION) qflx_irrig_sprinkler = 0._r8 #ifdef CROP - if(DEF_USE_IRRIGATION)then - call CalIrrigationApplicationFluxes(ipatch,ps,pe,deltim,qflx_irrig_drip,qflx_irrig_sprinkler,qflx_irrig_flood,qflx_irrig_paddy,irrig_flag=1) - end if + IF(DEF_USE_IRRIGATION)THEN + CALL CalIrrigationApplicationFluxes(ipatch,ps,pe,deltim,qflx_irrig_drip,qflx_irrig_sprinkler,qflx_irrig_flood,qflx_irrig_paddy,irrig_flag=1) + ENDIF #endif - if (DEF_Interception_scheme==1) THEN + IF (DEF_Interception_scheme==1) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& diff --git a/main/MOD_UserSpecifiedForcing.F90 b/main/MOD_UserSpecifiedForcing.F90 index 592a880d..cd98fbc2 100644 --- a/main/MOD_UserSpecifiedForcing.F90 +++ b/main/MOD_UserSpecifiedForcing.F90 @@ -25,7 +25,6 @@ MODULE MOD_UserSpecifiedForcing !------------------- !---In preparation - !ANCILLARY FUNCTIONS AND SUBROUTINES !------------------- !* :SUBROUTINE:"init_user_specified_forcing" : initialization of the selected forcing dataset @@ -39,9 +38,9 @@ MODULE MOD_UserSpecifiedForcing ! Siguang Zhu and Nan Wei, 10/2014: metpreprocess for forc_q calibration ! Hua Yuan, 04/2014: initial code of forcing structure for CoLM2014 - use MOD_Precision + USE MOD_Precision - implicit none + IMPLICIT NONE character(len=256) :: dataset @@ -53,8 +52,8 @@ MODULE MOD_UserSpecifiedForcing integer :: NVAR ! variable number of forcing data integer :: startyr ! start year of forcing data integer :: startmo ! start month of forcing data - integer :: endyr ! end year of forcing data - integer :: endmo ! end month of forcing data + integer :: endyr ! END year of forcing data + integer :: endmo ! END month of forcing data integer, allocatable :: dtime(:) ! time interval of forcing data integer, allocatable :: offset(:) ! offset of forcing data @@ -73,27 +72,27 @@ MODULE MOD_UserSpecifiedForcing character(len=256), allocatable :: vname(:) ! variable name character(len=256), allocatable :: tintalgo(:) ! interpolation algorithm - ! ----- public subroutines ----- - public :: init_user_specified_forcing ! initialization of the selected forcing dataset - public :: metfilename ! identify the forcing file name - public :: metpreprocess ! preprocess the forcing data + ! ----- PUBLIC subroutines ----- + PUBLIC :: init_user_specified_forcing ! initialization of the selected forcing dataset + PUBLIC :: metfilename ! identify the forcing file name + PUBLIC :: metpreprocess ! preprocess the forcing data CONTAINS ! ---------------- - subroutine init_user_specified_forcing + SUBROUTINE init_user_specified_forcing - use MOD_Namelist - implicit none + USE MOD_Namelist + IMPLICIT NONE - ! Local variables - integer :: ivar,NVAR_default + ! Local variables + integer :: ivar,NVAR_default NVAR = DEF_forcing%NVAR NVAR_default=NVAR - if (DEF_USE_CBL_HEIGHT) then + IF (DEF_USE_CBL_HEIGHT) THEN NVAR=NVAR+1 - endif + ENDIF IF (allocated(dtime )) deallocate(dtime) IF (allocated(offset)) deallocate(offset) @@ -129,39 +128,39 @@ subroutine init_user_specified_forcing groupby = DEF_forcing%groupby ! file grouped by year/month - do ivar = 1, NVAR_default + DO ivar = 1, NVAR_default fprefix (ivar) = DEF_forcing%fprefix(ivar) ! file prefix vname (ivar) = DEF_forcing%vname(ivar) ! variable name tintalgo(ivar) = DEF_forcing%tintalgo(ivar) ! interpolation algorithm - end do - if (DEF_USE_CBL_HEIGHT) then + END DO + IF (DEF_USE_CBL_HEIGHT) THEN fprefix (NVAR) = DEF_forcing%CBL_fprefix vname (NVAR) = DEF_forcing%CBL_vname tintalgo(NVAR) = DEF_forcing%CBL_tintalgo dtime(NVAR) = DEF_forcing%CBL_dtime offset(NVAR) = DEF_forcing%CBL_offset - endif - end subroutine init_user_specified_forcing + ENDIF + END SUBROUTINE init_user_specified_forcing ! ---------------- FUNCTION metfilename(year, month, day, var_i) - use MOD_Namelist - implicit none + USE MOD_Namelist + IMPLICIT NONE - integer, intent(in) :: year - integer, intent(in) :: month - integer, intent(in) :: day - integer, intent(in) :: var_i - character(len=256) :: metfilename - character(len=256) :: yearstr - character(len=256) :: monthstr + integer, intent(in) :: year + integer, intent(in) :: month + integer, intent(in) :: day + integer, intent(in) :: var_i + character(len=256) :: metfilename + character(len=256) :: yearstr + character(len=256) :: monthstr write(yearstr, '(I4.4)') year write(monthstr, '(I2.2)') month - select case (trim(DEF_forcing%dataset)) - case ('PRINCETON') ! Princeton forcing data + select CASE (trim(DEF_forcing%dataset)) + CASE ('PRINCETON') ! Princeton forcing data !DESCRIPTION !=========== !---Princeton Global Meteorological Forcing Dataset for Land Surface Modeling @@ -181,7 +180,7 @@ FUNCTION metfilename(year, month, day, var_i) !---2022.05.01 Zhongwang Wei @ SYSU: remove the "z" dimension metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'-'//trim(yearstr)//'.nc' - case ('GSWP3') ! GSWP3 forcing data + CASE ('GSWP3') ! GSWP3 forcing data !DESCRIPTION !=========== !---Global Meteorological Forcing Dataset for Global Soil Wetness Project Phase 3 @@ -201,7 +200,7 @@ FUNCTION metfilename(year, month, day, var_i) !---------------- !--- metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'-'//trim(monthstr)//'.nc' - case ('QIAN') ! Qian forcing data + CASE ('QIAN') ! Qian forcing data !DESCRIPTION !=========== !---Qian Global Meteorological Forcing Dataset from 1948 to 2004 @@ -220,7 +219,7 @@ FUNCTION metfilename(year, month, day, var_i) !--- metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'-'//trim(monthstr)//'.nc' - case ('CRUNCEPV4') ! CRUNCEP V4 forcing data + CASE ('CRUNCEPV4') ! CRUNCEP V4 forcing data !DESCRIPTION !=========== !---CRUNCEP Version 4 - Atmospheric Forcing Data for the Community Land Model @@ -239,7 +238,7 @@ FUNCTION metfilename(year, month, day, var_i) !--- metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'-'//trim(monthstr)//'.nc' - case ('CRUNCEPV7') ! CRUNCEP V7 forcing data + CASE ('CRUNCEPV7') ! CRUNCEP V7 forcing data !DESCRIPTION !=========== !---CRUNCEP Version 7 - Atmospheric Forcing Data for the Community Land Model @@ -261,7 +260,7 @@ FUNCTION metfilename(year, month, day, var_i) !--- metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'-'//trim(monthstr)//'.nc' - case ('ERA5LAND') ! ERA5-Land forcing data + CASE ('ERA5LAND') ! ERA5-Land forcing data !DESCRIPTION !=========== !---enhanced global dataset for the land component of the fifth @@ -283,25 +282,25 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//'_'//trim(yearstr)//'_'//trim(monthstr) - select case (var_i) - case (1) + select CASE (var_i) + CASE (1) metfilename = trim(metfilename) // '_2m_temperature.nc' - case (2) + CASE (2) metfilename = trim(metfilename) //'_specific_humidity.nc' - case (3) + CASE (3) metfilename = trim(metfilename) //'_surface_pressure.nc' - case (4) + CASE (4) metfilename = trim(metfilename) //'_total_precipitation_m_hr.nc' - case (5) + CASE (5) metfilename = trim(metfilename) //'_10m_u_component_of_wind.nc' - case (6) + CASE (6) metfilename = trim(metfilename) //'_10m_v_component_of_wind.nc' - case (7) + CASE (7) metfilename = trim(metfilename) //'_surface_solar_radiation_downwards_w_m2.nc' - case (8) + CASE (8) metfilename = trim(metfilename) //'_surface_thermal_radiation_downwards_w_m2.nc' END select - case ('ERA5') ! ERA5 forcing data + CASE ('ERA5') ! ERA5 forcing data !DESCRIPTION !=========== !---The fifth generation of European ReAnalysis (ERA5) @@ -321,25 +320,25 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//'_'//trim(yearstr)//'_'//trim(monthstr) - select case (var_i) - case (1) + select CASE (var_i) + CASE (1) metfilename = trim(metfilename) // '_2m_temperature.nc4' - case (2) + CASE (2) metfilename = trim(metfilename) //'_q.nc4' - case (3) + CASE (3) metfilename = trim(metfilename) //'_surface_pressure.nc4' - case (4) + CASE (4) metfilename = trim(metfilename) //'_mean_total_precipitation_rate.nc4' - case (5) + CASE (5) metfilename = trim(metfilename) //'_10m_u_component_of_wind.nc4' - case (6) + CASE (6) metfilename = trim(metfilename) //'_10m_v_component_of_wind.nc4' - case (7) + CASE (7) metfilename = trim(metfilename) //'_mean_surface_downward_short_wave_radiation_flux.nc4' - case (8) + CASE (8) metfilename = trim(metfilename) //'_mean_surface_downward_long_wave_radiation_flux.nc4' END select - case ('MSWX') ! MSWX forcing data + CASE ('MSWX') ! MSWX forcing data !DESCRIPTION !=========== !---Multi-Source Weather forcing data @@ -359,7 +358,7 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: Regroup data into monthly metfilename = '/'//trim(fprefix(var_i))//'_'//trim(yearstr)//'_'//trim(monthstr)//'.nc' - case ('WFDE5') + CASE ('WFDE5') !DESCRIPTION !=========== !---WATCH Forcing Data methodology applied to ERA5 reanalysis data @@ -379,7 +378,7 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//trim(monthstr)//'_v2.0.nc' - case ('CRUJRA') + CASE ('CRUJRA') !DESCRIPTION !=========== !---Collection of CRU JRA forcing datasets of gridded land surface blend @@ -404,7 +403,7 @@ FUNCTION metfilename(year, month, day, var_i) metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'.365d.noc.nc' - case ('WFDEI') + CASE ('WFDEI') !DESCRIPTION !=========== !---WATCH Forcing Data methodology applied to ERA-Interim reanalysis data @@ -424,7 +423,7 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//'-'//trim(monthstr)//'.nc' - case ('JRA55') + CASE ('JRA55') !DESCRIPTION !=========== !---the Japanese 55-year Reanalysis @@ -450,7 +449,7 @@ FUNCTION metfilename(year, month, day, var_i) metfilename = '/'//trim(fprefix(var_i))//'_'//trim(yearstr)//'.nc' - case ('GDAS') + CASE ('GDAS') !DESCRIPTION !=========== !--- Forcing Data From Global Data Assimilation System @@ -474,7 +473,7 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: merge the data into monthly file; zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//trim(monthstr)//'.nc4' - case ('CLDAS') + CASE ('CLDAS') !DESCRIPTION !=========== @@ -496,7 +495,7 @@ FUNCTION metfilename(year, month, day, var_i) !---2021.11.01 Zhongwang Wei @ SYSU: gap filling for the missing data; zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//'-'//trim(yearstr)//trim(monthstr)//'.nc' - case ('CMFD') + CASE ('CMFD') !DESCRIPTION !=========== !--- The China Meteorological Forcing Dataset @@ -516,7 +515,7 @@ FUNCTION metfilename(year, month, day, var_i) !--- metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//trim(monthstr)//'.nc4' - case ('CMIP6') + CASE ('CMIP6') !DESCRIPTION !=========== !---the Climate Model Intercomparison Project Phase 6 (CMIP6) forcing data sets @@ -536,7 +535,7 @@ FUNCTION metfilename(year, month, day, var_i) metfilename = '/'//trim(fprefix(var_i))//'_'//trim(yearstr)//'.nc' - case ('TPMFD') + CASE ('TPMFD') !DESCRIPTION !=========== !---A high-resolution near-surface meteorological forcing dataset for the Third Pole region @@ -559,249 +558,248 @@ FUNCTION metfilename(year, month, day, var_i) ! zip file to reduce the size of the data; remove offset and scale_factor metfilename = '/'//trim(fprefix(var_i))//trim(yearstr)//trim(monthstr)//'.nc' - case ('POINT') + CASE ('POINT') metfilename = '/'//trim(fprefix(1)) - end select - if (DEF_USE_CBL_HEIGHT) then - select case (var_i) - case (9) - metfilename = '/'//trim(fprefix(9))//'_'//trim(yearstr)//'_'//trim(monthstr)//'_boundary_layer_height.nc4' END select - endif + IF (DEF_USE_CBL_HEIGHT) THEN + select CASE (var_i) + CASE (9) + metfilename = '/'//trim(fprefix(9))//'_'//trim(yearstr)//'_'//trim(monthstr)//'_boundary_layer_height.nc4' + END select + ENDIF END FUNCTION metfilename ! preprocess for forcing data [not applicable yet for PRINCETON] ! ------------------------------------------------------------ SUBROUTINE metpreprocess(grid, forcn) - use MOD_Const_Physical - use MOD_Namelist - use MOD_SPMD_Task - use MOD_Block - use MOD_Grid - use MOD_DataType - USE MOD_Qsadv - implicit none - type(grid_type), intent(in) :: grid - type(block_data_real8_2d), intent(inout) :: forcn(:) + USE MOD_Const_Physical + USE MOD_Namelist + USE MOD_SPMD_Task + USE MOD_Block + USE MOD_Grid + USE MOD_DataType + USE MOD_Qsadv + IMPLICIT NONE + type(grid_type), intent(in) :: grid + type(block_data_real8_2d), intent(inout) :: forcn(:) - integer :: iblkme, ib, jb, i, j - real(r8) :: es, esdT, qsat_tmp, dqsat_tmpdT, e, ea + integer :: iblkme, ib, jb, i, j + real(r8) :: es, esdT, qsat_tmp, dqsat_tmpdT, e, ea !---------------------------------------------------------------------------- ! use polynomials to calculate saturation vapor pressure and derivative with ! respect to temperature: over water when t > 0 c and over ice when t <= 0 c ! required to convert relative humidity to specific humidity !---------------------------------------------------------------------------- - if (trim(DEF_forcing%dataset) == 'POINT') then + IF (trim(DEF_forcing%dataset) == 'POINT') THEN #ifdef SinglePoint - call qsadv(forcn(1)%blk(gblock%xblkme(1),gblock%yblkme(1))%val(1,1), & + CALL qsadv(forcn(1)%blk(gblock%xblkme(1),gblock%yblkme(1))%val(1,1), & forcn(3)%blk(gblock%xblkme(1),gblock%yblkme(1))%val(1,1), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(gblock%xblkme(1),gblock%yblkme(1))%val(1,1)) THEN + IF (qsat_tmp < forcn(2)%blk(gblock%xblkme(1),gblock%yblkme(1))%val(1,1)) THEN forcn(2)%blk(gblock%xblkme(1),gblock%yblkme(1))%val(1,1) = qsat_tmp ENDIF #endif - else + ELSE DO iblkme = 1, gblock%nblkme ib = gblock%xblkme(iblkme) jb = gblock%yblkme(iblkme) - do j = 1, grid%ycnt(jb) - do i = 1, grid%xcnt(ib) + DO j = 1, grid%ycnt(jb) + DO i = 1, grid%xcnt(ib) - select case (trim(DEF_forcing%dataset)) + select CASE (trim(DEF_forcing%dataset)) - case ('PRINCETON') + CASE ('PRINCETON') - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('GSWP2') + CASE ('GSWP2') - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('GSWP3') - if (forcn(1)%blk(ib,jb)%val(i,j)<212.0) forcn(1)%blk(ib,jb)%val(i,j) = 212.0 - if (forcn(4)%blk(ib,jb)%val(i,j)<0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CASE ('GSWP3') + IF (forcn(1)%blk(ib,jb)%val(i,j)<212.0) forcn(1)%blk(ib,jb)%val(i,j) = 212.0 + IF (forcn(4)%blk(ib,jb)%val(i,j)<0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('QIAN') + CASE ('QIAN') - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF e = forcn(3)%blk(ib,jb)%val(i,j) * forcn(2)%blk(ib,jb)%val(i,j) & / (0.622_R8 + 0.378_R8 * forcn(2)%blk(ib,jb)%val(i,j)) ea = 0.70_R8 + 5.95e-05_R8 * 0.01_R8 * e * exp(1500.0_R8/forcn(1)%blk(ib,jb)%val(i,j)) forcn(8)%blk(ib,jb)%val(i,j) = ea * stefnc * forcn(1)%blk(ib,jb)%val(i,j)**4 - case ('CRUNCEPV4') + CASE ('CRUNCEPV4') - if (forcn(1)%blk(ib,jb)%val(i,j) < 212.0) forcn(1)%blk(ib,jb)%val(i,j) = 212.0 - if (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - if (forcn(7)%blk(ib,jb)%val(i,j) < 0.0) forcn(7)%blk(ib,jb)%val(i,j) = 0.0 + IF (forcn(1)%blk(ib,jb)%val(i,j) < 212.0) forcn(1)%blk(ib,jb)%val(i,j) = 212.0 + IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + IF (forcn(7)%blk(ib,jb)%val(i,j) < 0.0) forcn(7)%blk(ib,jb)%val(i,j) = 0.0 ! 12th grade of Typhoon 32.7-36.9 m/s - if (abs(forcn(5)%blk(ib,jb)%val(i,j)) > 40.0) forcn(5)%blk(ib,jb)%val(i,j) = & + IF (abs(forcn(5)%blk(ib,jb)%val(i,j)) > 40.0) forcn(5)%blk(ib,jb)%val(i,j) = & 40.0*forcn(5)%blk(ib,jb)%val(i,j)/abs(forcn(5)%blk(ib,jb)%val(i,j)) - if (abs(forcn(6)%blk(ib,jb)%val(i,j)) > 40.0) forcn(6)%blk(ib,jb)%val(i,j) = & + IF (abs(forcn(6)%blk(ib,jb)%val(i,j)) > 40.0) forcn(6)%blk(ib,jb)%val(i,j) = & 40.0*forcn(6)%blk(ib,jb)%val(i,j)/abs(forcn(6)%blk(ib,jb)%val(i,j)) - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('CRUNCEPV7') + CASE ('CRUNCEPV7') - if (forcn(1)%blk(ib,jb)%val(i,j) < 212.0) forcn(1)%blk(ib,jb)%val(i,j) = 212.0 - if (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - if (forcn(7)%blk(ib,jb)%val(i,j) < 0.0) forcn(7)%blk(ib,jb)%val(i,j) = 0.0 + IF (forcn(1)%blk(ib,jb)%val(i,j) < 212.0) forcn(1)%blk(ib,jb)%val(i,j) = 212.0 + IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + IF (forcn(7)%blk(ib,jb)%val(i,j) < 0.0) forcn(7)%blk(ib,jb)%val(i,j) = 0.0 ! 12th grade of Typhoon 32.7-36.9 m/s - ! NOTE by Wenzong: This is a problem when running a GNU-compiled program, because there is + ! NOTE by Wenzong: This is a problem when running a GNU-compiled PROGRAM, because there is ! no data of forcn(5), temporarily comment the code below - ! if (abs(forcn(5)%blk(ib,jb)%val(i,j)) > 40.0) forcn(5)%blk(ib,jb)%val(i,j) = & + ! IF (abs(forcn(5)%blk(ib,jb)%val(i,j)) > 40.0) forcn(5)%blk(ib,jb)%val(i,j) = & ! 40.0*forcn(5)%blk(ib,jb)%val(i,j)/abs(forcn(5)%blk(ib,jb)%val(i,j)) - if (abs(forcn(6)%blk(ib,jb)%val(i,j)) > 40.0) forcn(6)%blk(ib,jb)%val(i,j) = & + IF (abs(forcn(6)%blk(ib,jb)%val(i,j)) > 40.0) forcn(6)%blk(ib,jb)%val(i,j) = & 40.0*forcn(6)%blk(ib,jb)%val(i,j)/abs(forcn(6)%blk(ib,jb)%val(i,j)) - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('ERA5LAND') + CASE ('ERA5LAND') forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j) * 1000./3600. - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('ERA5') + CASE ('ERA5') - if (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif - if (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + ENDIF + IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - case ('MSWX') + CASE ('MSWX') forcn(1)%blk(ib,jb)%val(i,j)=forcn(1)%blk(ib,jb)%val(i,j)+273.15 forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j)/10800. - if (forcn(4)%blk(ib,jb)%val(i,j)>1000.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + IF (forcn(4)%blk(ib,jb)%val(i,j)>1000.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif - if (forcn(2)%blk(ib,jb)%val(i,j)<0.5E-05) forcn(2)%blk(ib,jb)%val(i,j) = 0.5E-05 + ENDIF + IF (forcn(2)%blk(ib,jb)%val(i,j)<0.5E-05) forcn(2)%blk(ib,jb)%val(i,j) = 0.5E-05 - case ('WFDE5') + CASE ('WFDE5') - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('WFDEI') + CASE ('WFDEI') - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('CLDAS') ! CLDAS forcing + CASE ('CLDAS') ! CLDAS forcing forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j)/3600. - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('CMFD') ! CMFD forcing + CASE ('CMFD') ! CMFD forcing forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j)/3600. - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('CRUJRA') ! CRUJRA forcing + CASE ('CRUJRA') ! CRUJRA forcing forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j)/21600. forcn(7)%blk(ib,jb)%val(i,j)=forcn(7)%blk(ib,jb)%val(i,j)/21600. - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('GDAS') ! GDAS forcing + CASE ('GDAS') ! GDAS forcing - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('JRA55') ! JRA55 forcing + CASE ('JRA55') ! JRA55 forcing forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j)/86400. - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('TPMFD') ! TPMFD forcing + CASE ('TPMFD') ! TPMFD forcing forcn(4)%blk(ib,jb)%val(i,j)=forcn(4)%blk(ib,jb)%val(i,j)/3600.! convert to mm/s forcn(3)%blk(ib,jb)%val(i,j)=forcn(3)%blk(ib,jb)%val(i,j)*100. ! convert to pa - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif + ENDIF - case ('CMIP6') ! CMIP6 forcing + CASE ('CMIP6') ! CMIP6 forcing - if (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - call qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & + IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + CALL qsadv (forcn(1)%blk(ib,jb)%val(i,j), forcn(3)%blk(ib,jb)%val(i,j), & es,esdT,qsat_tmp,dqsat_tmpdT) - if (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) then + IF (qsat_tmp < forcn(2)%blk(ib,jb)%val(i,j)) THEN forcn(2)%blk(ib,jb)%val(i,j) = qsat_tmp - endif - if (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 - end select - - end do - end do - end do - end if - + ENDIF + IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 + END select + + END DO + END DO + END DO + END IF END SUBROUTINE metpreprocess END MODULE MOD_UserSpecifiedForcing