From 95eba5f73312c4deaa145a507b70d4b392859274 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 26 Jul 2016 15:34:54 +0200
Subject: [PATCH] Philippe 26/07/2016: * Find dad file number in SET_GRID
(added NOUTDAD variable in TOUTBAK datatype) * Allocate XBAK_TIME to the
right size
---
src/LIB/SURCOUCHE/src/mode_io.f90 | 5 +-
src/MNH/default_desfmn.f90 | 2 -
src/MNH/modeln.f90 | 27 ++--
src/MNH/read_desfmn.f90 | 2 +-
src/MNH/read_exsegn.f90 | 2 +-
src/MNH/set_grid.f90 | 198 +++++++++++++++++++-----------
6 files changed, 137 insertions(+), 99 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 72180c012..afcb24fa3 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -62,8 +62,9 @@ MODULE MODE_IO_ll
!Structure describing the characteristics of an output or a backup
TYPE TOUTBAK
- INTEGER :: NSTEP !Timestep number
- REAL :: XTIME !Time from start of the segment (in seconds and rounded to a timestep)
+ INTEGER :: NSTEP !Timestep number
+ REAL :: XTIME !Time from start of the segment (in seconds and rounded to a timestep)
+ INTEGER :: NOUTDAD = -1 !Index of the corresponding dad file (file with same time)
END TYPE TOUTBAK
PUBLIC TOUTBAK
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 0127a33f9..5b0965834 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -492,8 +492,6 @@ XTNUDGING = 21600.
!* 9. SET DEFAULT VALUES FOR MODD_FMOUT and MODD_OUT_n :
! ------------------------------------------------
!
-!XBAK_TIME is not yet allocated
-!IF (KMI == 1) XBAK_TIME (:,:) = XNEGUNDEF
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 321857caf..885204b0f 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -430,8 +430,6 @@ INTEGER :: INPRAR ! number of articles predicted in
INTEGER :: ININAR ! number of articles present in
! the LFIFM file
INTEGER :: ITYPE ! type of file (cpio or not)
-INTEGER :: IOUTDAD ! numero of the OUTPUT FM-file of DAD model
-INTEGER :: JOUTDAD ! loop index on the output instant list for DAD model
LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
!
! for computing time analysis
@@ -906,7 +904,8 @@ IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI)
ZTIME1 = ZTIME2
!
YFMFILE=' '
-IF (KTCOUNT == TOUTBAKN(IOUT+1)%NSTEP) THEN
+IF (IOUT < NOUT_NUMB ) THEN
+ IF (KTCOUNT == TOUTBAKN(IOUT+1)%NSTEP) THEN
IOUT=IOUT+1
GCLOSE_OUT=.TRUE.
INPRAR = 22 +2*(4+NRR+NSV)
@@ -915,22 +914,13 @@ IF (KTCOUNT == TOUTBAKN(IOUT+1)%NSTEP) THEN
!
! search for the corresponding Output of the DAD model
!
- IF (NDAD(IMI) == IMI .OR. IMI == 1) THEN
+ IF (TOUTBAKN(IOUT)%NOUTDAD < 0) THEN
+ WRITE (YDADFILE,FMT="('NO_DAD_FILE')")
+ ELSE IF (TOUTBAKN(IOUT)%NOUTDAD == 0) THEN
YDADFILE=YFMFILE
ELSE
- IOUTDAD=0
-!PW: TODO/TOCHECK: est-ce que cela fait la meme chose qu'avant?
- DO JOUTDAD =1,JPOUTMAX
- IF ( XBAK_TIME(NDAD(IMI),JOUTDAD) >=0. .AND. &
- XBAK_TIME(NDAD(IMI),JOUTDAD) <= (TOUTBAKN(IOUT)%XTIME+1.E-10) ) &
- IOUTDAD=IOUTDAD+1
- END DO
- IF(IOUTDAD>0) THEN
- WRITE (YDADNUMBER,FMT="('.',I3.3)") IOUTDAD
- YDADFILE=ADJUSTL(ADJUSTR(CDAD_NAME(IMI))//YDADNUMBER)
- ELSE
- WRITE (YDADFILE,FMT="('NO_DAD_FILE')")
- END IF
+ WRITE (YDADNUMBER,FMT="('.',I3.3)") TOUTBAKN(IOUT)%NOUTDAD
+ YDADFILE=ADJUSTL(ADJUSTR(CDAD_NAME(IMI))//YDADNUMBER)
END IF
!
CALL FMOPEN_ll(YFMFILE,'WRITE',CLUOUT,INPRAR,ITYPE,NVERB,ININAR,IRESP)
@@ -960,6 +950,7 @@ IF (KTCOUNT == TOUTBAKN(IOUT+1)%NSTEP) THEN
END IF
!
END IF
+END IF
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1309,7 +1300,7 @@ IF (CDCONV/='NONE') THEN
END IF
END IF
!
-IF (IOUT>0) THEN
+IF (IOUT>0 .AND. IOUT <= NOUT_NUMB ) THEN
IF (KTCOUNT == TOUTBAKN(IOUT)%NSTEP) THEN
IF (CSURF=='EXTE') THEN
CALL GOTO_SURFEX(IMI)
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index 365f91c3d..6e3db0ae9 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -424,7 +424,7 @@ IF (KMI == 1) THEN
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_NESTING)
CALL POSNAM(ILUDES,'NAM_FMOUT',GFOUND)
IF (GFOUND) THEN
- IF (.NOT.ALLOCATED(XBAK_TIME)) ALLOCATE(XBAK_TIME(JPMODELMAX,JPOUTMAX))
+ IF (.NOT.ALLOCATED(XBAK_TIME)) ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
READ(UNIT=ILUDES,NML=NAM_FMOUT)
XBAK_TIME(:,:) = XNEGUNDEF
END IF
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 85e131813..c4f52170e 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -496,7 +496,7 @@ IF (KMI == 1) THEN
CALL POSNAM(ILUSEG,'NAM_FMOUT',GFOUND,ILUOUT)
IF (GFOUND) THEN
!Should have been allocated before in READ_DESFM_n
- IF (.NOT.ALLOCATED(XBAK_TIME)) ALLOCATE(XBAK_TIME(JPMODELMAX,JPOUTMAX))
+ IF (.NOT.ALLOCATED(XBAK_TIME)) ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
XBAK_TIME(:,:) = XNEGUNDEF
READ(UNIT=ILUSEG,NML=NAM_FMOUT)
END IF
diff --git a/src/MNH/set_grid.f90 b/src/MNH/set_grid.f90
index 4fdf711d0..158555ea3 100644
--- a/src/MNH/set_grid.f90
+++ b/src/MNH/set_grid.f90
@@ -86,10 +86,10 @@ TYPE (DATE_TIME), INTENT(OUT) :: TPDTMOD ! date and time of the model
TYPE (DATE_TIME), INTENT(OUT) :: TPDTCUR ! Current date and time
INTEGER, INTENT(OUT) :: KSTOP ! number of time steps for
! current segment
-INTEGER, INTENT(OUT) :: KOUT_NUMB ! number of outputs
+INTEGER,POINTER, INTENT(OUT) :: KOUT_NUMB ! number of outputs
+TYPE(TOUTBAK),DIMENSION(:),POINTER,INTENT(OUT) :: TPOUTBAKN ! List of outputs and backups
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PJ ! Jacobian
-TYPE(TOUTBAK),DIMENSION(:),POINTER,INTENT(OUT) :: TPOUTBAKN ! List of outputs and backups
!
END SUBROUTINE SET_GRID
!
@@ -251,7 +251,9 @@ USE MODE_ll
USE MODI_GATHER_ll !!!! a mettre dans mode_ll
!
USE MODE_FMREAD
+USE MODD_OUT_n, ONLY : OUT_MODEL
USE MODD_VAR_ll, ONLY : IP,NPROC
+USE MODD_DYN_n, ONLY : DYN_MODEL
!
IMPLICIT NONE
!
@@ -313,10 +315,10 @@ TYPE (DATE_TIME), INTENT(OUT) :: TPDTMOD ! date and time of the model
TYPE (DATE_TIME), INTENT(OUT) :: TPDTCUR ! Current date and time
INTEGER, INTENT(OUT) :: KSTOP ! number of time steps for
! current segment
-INTEGER, INTENT(OUT) :: KOUT_NUMB ! number of outputs
+INTEGER,POINTER, INTENT(OUT) :: KOUT_NUMB ! number of outputs
+TYPE(TOUTBAK),DIMENSION(:),POINTER,INTENT(OUT) :: TPOUTBAKN ! List of outputs and backups
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PJ ! Jacobian
-TYPE(TOUTBAK),DIMENSION(:),POINTER,INTENT(OUT) :: TPOUTBAKN ! List of outputs and backups
!
!* 0.2 declarations of local variables
!
@@ -342,6 +344,8 @@ INTEGER :: IIUP,IJUP ,ISUP=1 ! size of working
! supp. time steps
!
INTEGER :: IMASDEV ! masdev of the file
+INTEGER :: IMI ! model number for loop
+INTEGER :: IOUT_NUMB ! number of outputs
!-------------------------------------------------------------------------------
!
YRECFM='MASDEV'
@@ -511,87 +515,131 @@ KSTOP = NINT(PSEGLEN/PTSTEP)
!
!* 2.3 Temporal grid - outputs managment
!
-!* 2.3.1 Synchronization between nested models through XBAK_TIME arrays (MODD_FMOUT)
-!
-DO JOUT = 1,JPOUTMAX
- IF (XBAK_TIME(KMI,JOUT) >= 0.) THEN
- !Value is rounded to nearest timestep
- XBAK_TIME(KMI,JOUT) = NINT(XBAK_TIME(KMI,JOUT)/PTSTEP) * PTSTEP
- !Output/backup time is propagated to nested models (with higher numbers)
- !PW: TODO: BUG?: what happens if 2 dissociated models?
- DO JKLOOP = KMI+1,JPMODELMAX
- IDX = 1
- !Find first non 'allocated' element
- DO WHILE ( XBAK_TIME(JKLOOP,IDX) >= 0. )
- IDX = IDX + 1
+! The output/backups times have been read only by model 1
+IF (KMI == 1) THEN
+DO IMI = 1, NMODEL
+ !
+ !* 2.3.1 Synchronization between nested models through XBAK_TIME arrays (MODD_FMOUT)
+ !
+ DO JOUT = 1,JPOUTMAX
+ IF (XBAK_TIME(IMI,JOUT) >= 0.) THEN
+ !Value is rounded to nearest timestep
+ XBAK_TIME(IMI,JOUT) = NINT(XBAK_TIME(IMI,JOUT)/DYN_MODEL(IMI)%XTSTEP) * DYN_MODEL(IMI)%XTSTEP
+ !Output/backup time is propagated to nested models (with higher numbers)
+ !PW: TODO: BUG?: what happens if 2 dissociated models?
+ DO JKLOOP = IMI+1,NMODEL
+ IDX = 1
+ !Find first non 'allocated' element
+ DO WHILE ( XBAK_TIME(JKLOOP,IDX) >= 0. )
+ IDX = IDX + 1
+ END DO
+ IF (IDX > JPOUTMAX) THEN
+ PRINT *,'Error in SET_GRID when treating output list'
+ CALL ABORT
+ STOP
+ END IF
+ XBAK_TIME(JKLOOP,IDX) = XBAK_TIME(IMI,JOUT)
END DO
- IF (IDX > JPOUTMAX) THEN
- PRINT *,'Error in SET_GRID when treating output list'
- CALL ABORT
- STOP
+ END IF
+ END DO
+ !
+ !* 2.3.2 Find duplicated entries
+ !
+ DO JOUT = 1,JPOUTMAX
+ DO JKLOOP = JOUT+1,JPOUTMAX
+ IF ( XBAK_TIME(IMI,JKLOOP) == XBAK_TIME(IMI,JOUT) .AND. XBAK_TIME(IMI,JKLOOP) >= 0. ) THEN
+ print *,'WARNING: found duplicated backup (removed extra one)'
+ XBAK_TIME(IMI,JKLOOP) = -1.
END IF
- XBAK_TIME(JKLOOP,IDX) = XBAK_TIME(KMI,JOUT)
END DO
- END IF
-END DO
-!
-!* 2.3.2 Find duplicated entries
-!
-DO JOUT = 1,JPOUTMAX
- DO JKLOOP = JOUT+1,JPOUTMAX
- IF ( XBAK_TIME(KMI,JKLOOP) == XBAK_TIME(KMI,JOUT) .AND. XBAK_TIME(KMI,JKLOOP) >= 0. ) THEN
- print *,'WARNING: found duplicated backup (removed extra one)'
- XBAK_TIME(KMI,JKLOOP) = -1.
+ END DO
+ !
+ !* 2.3.3 Sort entries
+ !
+ DO JOUT = 1,JPOUTMAX
+ ZTEMP = XBAK_TIME(IMI,JOUT)
+ IF (ZTEMP<0.) ZTEMP = 1e99
+ IPOS = -1
+ DO JKLOOP = JOUT+1,JPOUTMAX
+ IF ( XBAK_TIME(IMI,JKLOOP) < ZTEMP .AND. XBAK_TIME(IMI,JKLOOP) >= 0. ) THEN
+ ZTEMP = XBAK_TIME(IMI,JKLOOP)
+ IPOS = JKLOOP
+ END IF
+ END DO
+ IF (IPOS >= JOUT) THEN
+ XBAK_TIME(IMI,IPOS) = XBAK_TIME(IMI,JOUT)
+ XBAK_TIME(IMI,JOUT) = ZTEMP
END IF
END DO
-END DO
-!
-!* 2.3.3 Sort entries
-!
-DO JOUT = 1,JPOUTMAX
- ZTEMP = XBAK_TIME(KMI,JOUT)
- IF (ZTEMP<0.) ZTEMP = 1e99
- IPOS = -1
- DO JKLOOP = JOUT+1,JPOUTMAX
- IF ( XBAK_TIME(KMI,JKLOOP) < ZTEMP .AND. XBAK_TIME(KMI,JKLOOP) >= 0. ) THEN
- ZTEMP = XBAK_TIME(KMI,JKLOOP)
- IPOS = JKLOOP
+ !
+ !* 2.3.4 counting the output number of model IMI
+ !
+ IOUT_NUMB = 0
+ DO JOUT = 1,JPOUTMAX
+ IF (XBAK_TIME(IMI,JOUT) >= 0.) THEN
+ IOUT_NUMB = IOUT_NUMB + 1
END IF
END DO
- IF (IPOS >= JOUT) THEN
- XBAK_TIME(KMI,IPOS) = XBAK_TIME(KMI,JOUT)
- XBAK_TIME(KMI,JOUT) = ZTEMP
+ !
+ OUT_MODEL(IMI)%NOUT_NUMB = IOUT_NUMB
+ ALLOCATE(OUT_MODEL(IMI)%TOUTBAKN(IOUT_NUMB))
+ !
+ IPOS = 0
+ DO JOUT = 1,JPOUTMAX
+ IF (XBAK_TIME(IMI,JOUT) >= 0.) THEN
+ IPOS = IPOS + 1
+ OUT_MODEL(IMI)%TOUTBAKN(IPOS)%NSTEP = NINT(XBAK_TIME(IMI,JOUT)/DYN_MODEL(IMI)%XTSTEP) + 1
+ OUT_MODEL(IMI)%TOUTBAKN(IPOS)%XTIME = XBAK_TIME(IMI,JOUT)
+ END IF
+ END DO
+ !
+ !* 2.3.5 finding dad output number
+ !
+ !Security check (if it happens, this part of the code should be exported outside of the IMI loop)
+ IF (NDAD(IMI)>IMI) THEN
+ print *,'ERROR in SET_GRID'
+ STOP
END IF
-END DO
-!
-!* 2.3.4 counting the output number of model KMI
-!
-KOUT_NUMB = 0
-DO JOUT = 1,JPOUTMAX
- IF (XBAK_TIME(KMI,JOUT) >= 0.) THEN
- KOUT_NUMB = KOUT_NUMB + 1
+ IF (NDAD(IMI) == IMI .OR. IMI == 1) THEN
+ OUT_MODEL(IMI)%TOUTBAKN(:)%NOUTDAD = 0
+ ELSE
+ DO IPOS = 1,OUT_MODEL(IMI)%NOUT_NUMB
+ IDX = 0
+ DO JOUT = 1,OUT_MODEL(NDAD(IMI))%NOUT_NUMB
+ IF ( OUT_MODEL(NDAD(IMI))%TOUTBAKN(JOUT)%XTIME <= OUT_MODEL(IMI)%TOUTBAKN(IPOS)%XTIME+1.E-6 ) THEN
+ IDX = JOUT
+ ELSE
+ EXIT
+ END IF
+ END DO
+ IF (IDX>0) THEN
+ OUT_MODEL(IMI)%TOUTBAKN(IPOS)%NOUTDAD = IDX
+ ELSE
+ OUT_MODEL(IMI)%TOUTBAKN(IPOS)%NOUTDAD = -1
+ END IF
+ END DO
END IF
-END DO
-ALLOCATE(TPOUTBAKN(KOUT_NUMB))
-IPOS = 0
-DO JOUT = 1,JPOUTMAX
- IF (XBAK_TIME(KMI,JOUT) >= 0.) THEN
- IPOS = IPOS + 1
- TPOUTBAKN(IPOS)%NSTEP = NINT(XBAK_TIME(KMI,JOUT)/PTSTEP) + 1
- TPOUTBAKN(IPOS)%XTIME = XBAK_TIME(KMI,JOUT)
+ !
+ !
+ IF (IP==1) THEN
+ PRINT *,'-------------------------'
+ PRINT *,'Model number: ',IMI
+ PRINT *,'Number of backups: ',IOUT_NUMB
+ PRINT *,'Timestep Time'
+ DO JOUT = 1,IOUT_NUMB
+ WRITE(*,'( I9 F12.3 )' ) OUT_MODEL(IMI)%TOUTBAKN(JOUT)%NSTEP,OUT_MODEL(IMI)%TOUTBAKN(JOUT)%XTIME
+ END DO
+ PRINT *,'-------------------------'
END IF
-END DO
-!
-IF (IP==1) THEN
-PRINT *,'-------------------------'
-PRINT *,'Model number: ',KMI
-PRINT *,'Number of backups: ',KOUT_NUMB
-PRINT *,'Timestep Time'
-DO JOUT = 1,KOUT_NUMB
- WRITE(*,'( I9 F12.3 )' ) TPOUTBAKN(JOUT)%NSTEP,TPOUTBAKN(JOUT)%XTIME
-END DO
-PRINT *,'-------------------------'
-END IF
+ !
+END DO ! IMI=1,NMODEL
+!
+DEALLOCATE(XBAK_TIME)
+!
+END IF ! IMI==1
+!
+KOUT_NUMB => OUT_MODEL(KMI)%NOUT_NUMB
+TPOUTBAKN => OUT_MODEL(KMI)%TOUTBAKN
!
!-------------------------------------------------------------------------------
!
--
GitLab