!! Copyright (C) Stichting Deltares, 2005-2023. !! !! This file is part of iMOD. !! !! This program is free software: you can redistribute it and/or modify !! it under the terms of the GNU General Public License as published by !! the Free Software Foundation, either version 3 of the License, or !! (at your option) any later version. !! !! This program is distributed in the hope that it will be useful, !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! GNU General Public License for more details. !! !! You should have received a copy of the GNU General Public License !! along with this program. If not, see . !! !! Contact: imod.support@deltares.nl !! Stichting Deltares !! P.O. Box 177 !! 2600 MH Delft, The Netherlands. !! MODULE MOD_IMPORT_CALC !http://water.usgs.gov/nrp/gwsoftware/modflow2000/MFDOC/index.html !http://water.usgs.gov/ogw/modflow/MODFLOW-2005-Guide USE WINTERACTER USE MOD_UTL, ONLY : UTL_GETUNIT,VTOS,UTL_CAP,UTL_CREATEDIR,UTL_JDATETOIDATE,UTL_CLOSEUNITS,FTIMETOITIME,UTL_DIST USE MOD_IMPORT_PAR USE MOD_IMPORT_UTL USE MOD_IDF, ONLY : IDFALLOCATEX,IDFALLOCATESXY,IDFDEALLOCATEX,IDFREAD,IDFDEALLOCATE,IDFNULLIFY,IDFGETLOC USE MOD_OSD, ONLY : OSD_OPEN USE MOD_ISG_PAR, ONLY : ISG,ISP,ISGDOUBLE,NISG,ISFR,ISD,DATISD,ISC,DATISC USE MOD_ISG_UTL, ONLY : ISGOPENFILES,ISGSAVEIT CHARACTER(LEN=256),PRIVATE :: LINE INTEGER,PRIVATE :: NPER,ISS CONTAINS !###==================================================================== SUBROUTINE IMPORT_MF2005_MAIN(MFFNAME,OUTNAME,IDFNAME) !###==================================================================== IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) :: MFFNAME,OUTNAME,IDFNAME CHARACTER(LEN=3) :: EXT INTEGER :: IU,KU,IOS,I TYPE(IDFOBJ) :: IDF IU=UTL_GETUNIT() CALL OSD_OPEN(IU,FILE=MFFNAME,STATUS='OLD',ACTION='READ',IOSTAT=IOS) IF(IOS.NE.0)THEN; WRITE(*,'(/A)') 'iMOD cannot open file:'//TRIM(MFFNAME); STOP; ENDIF CALL IOSDIRCHANGE(MFFNAME(:INDEX(MFFNAME,'\',.TRUE.)-1)) CALL UTL_CREATEDIR(OUTNAME(:INDEX(OUTNAME,'\',.TRUE.)-1)) KU=UTL_GETUNIT() CALL OSD_OPEN(KU,FILE=OUTNAME,STATUS='REPLACE',ACTION='WRITE',IOSTAT=IOS) IF(IOS.NE.0)THEN; WRITE(*,'(/A)') 'iMOD cannot open file:'//TRIM(OUTNAME); STOP; ENDIF CALL IDFNULLIFY(IDF); IF(TRIM(IDFNAME).NE.'')THEN; IF(.NOT.IDFREAD(IDF,IDFNAME,1))RETURN; ENDIF !## get type of file I=INDEX(MFFNAME,'.',.TRUE.); READ(MFFNAME(I+1:),*) EXT; EXT=UTL_CAP(EXT,'U') SELECT CASE (EXT) CASE ('WEL') CALL IMPORT_MF2005_WEL(IU,KU,IDF) END SELECT END SUBROUTINE IMPORT_MF2005_MAIN !###==================================================================== SUBROUTINE IMPORT_MF2005_WEL(IU,KU,IDF) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IU,KU TYPE(IDFOBJ),INTENT(INOUT) :: IDF INTEGER :: I,J,IL,IR,IC,IS,MS,N,IT,JU,IOS REAL(KIND=DP_KIND) :: QQ REAL(KIND=DP_KIND),ALLOCATABLE,DIMENSION(:,:) :: Q CHARACTER(LEN=256) :: LINE,FNAME DO I=1,2 MS=0; IT=0; READ(IU,*) N DO READ(IU,*,IOSTAT=IOS) N IF(IOS.NE.0)EXIT IT=IT+1 IF(N.GT.0)THEN READ(IU,'(A256)') LINE; LINE=UTL_CAP(LINE,'U') JU=IU IF(INDEX(LINE,'OPEN/CLOSE').GT.0)THEN READ(LINE(11:),*) FNAME JU=UTL_GETUNIT() CALL OSD_OPEN(JU,FILE='.'//FNAME,STATUS='OLD',ACTION='READ',IOSTAT=IOS) IF(IOS.NE.0)THEN; WRITE(*,'(/A)') 'iMOD cannot open file:'//TRIM(FNAME); STOP; ENDIF ENDIF DO J=1,N READ(JU,*) IL,IR,IC,QQ,IS MS=MAX(MS,IS) IF(ASSOCIATED(IDF%X))THEN IF(IDF%X(IC,IR).EQ.IDF%NODATA)QQ=0.0D0 ENDIF IF(I.EQ.2)Q(IS,IT)=Q(IS,IT)+QQ ENDDO IF(JU.NE.IU)CLOSE(JU) ENDIF ENDDO IF(I.EQ.1)THEN; ALLOCATE(Q(MS,IT)); Q=0.0D0; REWIND(IU); ENDIF ENDDO WRITE(KU,'(A10,99I17)') 'TTSTEP',(J,J=1,MS) DO I=1,IT WRITE(KU,'(I10,99F17.5)') I,(Q(J,I),J=1,MS) ENDDO WRITE(KU,'(10X,99F17.5)') (SUM(Q(J,1:IT)),J=1,MS) DEALLOCATE(Q) END SUBROUTINE IMPORT_MF2005_WEL !###==================================================================== LOGICAL FUNCTION IMPORT_CALC(IBATCH,IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IBATCH,IITYPE TYPE(WIN_MESSAGE) :: MESSAGE INTEGER :: ITYPE,I,IH,IM,IS,KPER REAL(KIND=DP_KIND) :: DT,TT,TDT,FTIME IMPORT_CALC=.FALSE. CALL UTL_MESSAGEHANDLE(0) IF(IVERSION.EQ.1)MVERSION=1988 IF(IVERSION.EQ.2)MVERSION=1996 IF(IVERSION.EQ.3)MVERSION=2000 IF(IVERSION.EQ.4)MVERSION=2005 IF(.NOT.IMPORT_INIT())RETURN IF(.NOT.IMPORT_READCONFIG(IITYPE))RETURN IF(.NOT.IMPORT_BAS())RETURN IF(.NOT.IMPORT_DIS())RETURN IF(IITYPE.EQ.1)THEN IF(IDF%IEQ.EQ.0)THEN WRITE(IURUN,'(8I10)') NLAY,NLAY,SUM(NSTP),0,1,0,0,0 WRITE(IURUN,'(5I10)') 1,0,0,0,0 ELSE WRITE(IURUN,'(8I10)') NLAY,NLAY,SUM(NSTP),0,0,0,0,0 WRITE(IURUN,'(5I10)') 0,0,0,0,0 ENDIF IF(.NOT.IMPORT_PCG(IITYPE))RETURN ! IF(IDF%IEQ.EQ.0)THEN ! WRITE(IURUN,'(6(F10.2,1X))') IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX,IDF%DX,0.0D0 ! ELSE WRITE(IURUN,'(6(F10.2,1X))') IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX,IDF%DX,IDF%DX ! ENDIF WRITE(IURUN,'(A)') 'ACTIVE MODULES' WRITE(IURUN,'(A)') '1,1,0 (BND)' WRITE(IURUN,'(A)') '1,1,0 (SHD)' WRITE(IURUN,'(A)') '1,1,0 (KDW)' WRITE(IURUN,'(A)') '1,1,0 (VCW)' IF(ISS.EQ.1)WRITE(IURUN,'(A)') '1,1,0 (STO)' IF(IUNIT(IANI).NE.0)WRITE(IURUN,'(A)') '1,1,0 (ANI)' IF(IUNIT(IHFB).NE.0)WRITE(IURUN,'(A)') '1,1,0 (HFB)' IF(IUNIT(ISCR).NE.0)WRITE(IURUN,'(A)') '1,1,0 (SCR)' IF(IUNIT(IMOC).NE.0)WRITE(IURUN,'(A)') '1,1,0 (CON)' IF(IUNIT(ITOP).NE.0)WRITE(IURUN,'(A)') '1,1,0 (TOP)' IF(IUNIT(IBOT).NE.0)WRITE(IURUN,'(A)') '1,1,0 (BOT)' IF(IUNIT(IWEL).NE.0)WRITE(IURUN,'(A)') '1,1,0 (WEL)' IF(IUNIT(IDRN).NE.0)WRITE(IURUN,'(A)') '1,1,0 (DRN)' IF(IUNIT(IRIV).NE.0)WRITE(IURUN,'(A)') '1,1,0 (RIV)' IF(IUNIT(IEVT).NE.0)WRITE(IURUN,'(A)') '1,1,0 (EVT)' IF(IUNIT(IGHB).NE.0)WRITE(IURUN,'(A)') '1,1,0 (GHB)' IF(IUNIT(IRCH).NE.0)WRITE(IURUN,'(A)') '1,1,0 (RCH)' IF(IUNIT(ICHD).NE.0)WRITE(IURUN,'(A)') '1,1,0 (CHD)' LINE=TRIM(DIR_DBS)//'\BND\VERSION_1\BND_'//TRIM(VTOS(1))//'.IDF' WRITE(IURUN,'(A)') '"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') 'MODULES FOR EACH LAYER' ELSE IF(.NOT.IMPORT_PCG(IITYPE))RETURN ENDIF CALL IMPORT_READBASINRUNFILE(IITYPE) SELECT CASE (MVERSION) CASE (2000,2005) IF(.NOT.IMPORT_LPF(IITYPE).AND..NOT.IMPORT_BCF(IITYPE).AND..NOT.IMPORT_HUF(IITYPE))THEN !RETURN !.AND..NOT.IMPORT_HUF() ENDIF CASE DEFAULT IF(.NOT.IMPORT_BCF(IITYPE))RETURN END SELECT IF(.NOT.IMPORT_ANI())RETURN IF(.NOT.IMPORT_HFB())RETURN IF(.NOT.IMPORT_MOC())RETURN IF(.NOT.IMPORT_SCR())RETURN IF(IITYPE.EQ.1)WRITE(IURUN,'(A)') 'PACKAGES FOR EACH LAYER AND STRESS-PERIOD' IF(IBATCH.EQ.0)THEN CALL WINDOWSELECT(0) CALL WINDOWOUTSTATUSBAR(2,'Press Escape to stop!') ENDIF !## compute timestamps ALLOCATE(TSTAMP(NPER+1)) WRITE(LONGDATE2,'(I8)') UTL_JDATETOIDATE(INT(TPER(0))) !; TSTAMP(0)=LONGDATE2 KPER=0; DO IPER=1,NPER TDT=0.0D0 KPER=KPER+1 TDT=TDT+DTPER(IPER) IF(NPER.GT.1)THEN !## begin date IF(NSTP(IPER).EQ.1)THEN WRITE(LONGDATE1,'(I8)') UTL_JDATETOIDATE(INT(TPER(IPER-1))) WRITE(LONGDATE2,'(I8)') UTL_JDATETOIDATE(INT(TPER(IPER))) ELSE LONGDATE1=LONGDATE2 !## get number of hours,minutes,seconds FTIME=TDT-INT(TDT); CALL FTIMETOITIME(FTIME,IH,IM,IS) TT=TPER(IPER-1)+INT(TDT) IF(IH+IM+IS.EQ.0)THEN WRITE(LONGDATE2,'(I8)') UTL_JDATETOIDATE(INT(TT)) ELSE WRITE(LONGDATE2,'(I8,3I2.2)') UTL_JDATETOIDATE(INT(TT)),IH,IM,IS ENDIF ENDIF ELSE LONGDATE1='STEADY-STATE' ENDIF TSTAMP(IPER)=LONGDATE1 ENDDO TSTAMP(NPER+1)=LONGDATE2 IF(IITYPE.EQ.1)THEN DO IPER=1,NPER CALL WMESSAGEPEEK(ITYPE,MESSAGE) IF(ITYPE.EQ.KEYDOWN.AND.MESSAGE%VALUE1.EQ.KEYESCAPE)THEN CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,'Are you sure to stop the import ? ','Question') IF(WINFODIALOG(4).EQ.1)EXIT ENDIF IF(IBATCH.EQ.0)THEN IF(NPER.EQ.1)CALL WINDOWOUTSTATUSBAR(1,'Busy importing steady-state period') IF(NPER.GT.1)CALL WINDOWOUTSTATUSBAR(1,'Busy importing transient period '//TRIM(VTOS(IPER))//' date: '//TRIM(TSTAMP(IPER))) !& ELSE IF(NPER.EQ.1)WRITE(*,'(A)') 'Busy importing steady-state period' IF(NPER.GT.1)WRITE(*,'(A,I5,A)') 'Busy importing transient period ',IPER,' date: '//TRIM(TSTAMP(IPER)) ENDIF LINE=TRIM(VTOS(KPER))//','//TRIM(VTOS(DT,'G',7))//','//TRIM(TSTAMP(IPER))//','//TRIM(VTOS(1))//','//TRIM(TSTAMP(IPER+1)) WRITE(IURUN,'(A)') TRIM(LINE) IF(IPER.EQ.1)THEN IF(.NOT.IMPORT_WEL(IITYPE))RETURN IF(.NOT.IMPORT_DRN()) RETURN IF(.NOT.IMPORT_RIV()) RETURN IF(.NOT.IMPORT_EVT()) RETURN IF(.NOT.IMPORT_GHB()) RETURN IF(.NOT.IMPORT_RCH(IITYPE))RETURN IF(.NOT.IMPORT_OLF()) RETURN IF(.NOT.IMPORT_CHD()) RETURN IF(.NOT.IMPORT_ISG()) RETURN ELSE IF(IUNIT(IWEL).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(WEL)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IDRN).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(DRN)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IRIV).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(RIV)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IEVT).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(EVT)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IGHB).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(GHB)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IRCH).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(RCH)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(ICHD).EQ.0)THEN; LINE=' '//TRIM(VTOS(-1))//',(CHD)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF ENDIF ENDDO ELSE DO IPER=1,NPER; IF(.NOT.IMPORT_WEL(IITYPE))RETURN; ENDDO DO IPER=1,NPER; IF(.NOT.IMPORT_RCH(IITYPE))RETURN; ENDDO IF(.NOT.IMPORT_SFR())RETURN ENDIF !10 continue !## try to import pth file IF(.NOT.IMPORT_PTH())RETURN !## try to import head files IF(.NOT.IMPORT_HDS())RETURN !## try constucting timeseries from *.hob files ! IF(.NOT.IMPORT_HOB())RETURN ! cos() sin() ! ! -sin() cos() ! ! XROT=XNEW* COS(RAD)+YNEW*SIN(RAD) !x1' ! YROT=XNEW*(-1.0D0*SIN(RAD))+YNEW*COS(RAD) !y1' IF(IITYPE.EQ.1)THEN IF(IPER.GT.NPER)THEN !## correct bas for chd package IF(.NOT.IMPORT_BAS_CHDCORRECTION())RETURN IF(.NOT.IMPORT_BCF_CORRECTION())RETURN ENDIF ENDIF CALL IMPORT_CLOSE() CALL UTL_CLOSEUNITS() IF(IBATCH.EQ.0)THEN CALL WINDOWOUTSTATUSBAR(1,'') CALL WINDOWOUTSTATUSBAR(2,'') CALL WINDOWOUTSTATUSBAR(3,'') CALL WINDOWOUTSTATUSBAR(4,'') ENDIF CALL UTL_MESSAGEHANDLE(1) CALL IDFDEALLOCATE(BAS,SIZE(BAS)); DEALLOCATE(BAS); DEALLOCATE(TSTAMP) IMPORT_CALC=.TRUE. IF(IBATCH.EQ.0)THEN CALL WMESSAGEBOX(OKONLY,INFORMATIONICON,COMMONOK,'Import Successfully completed.'//CHAR(13)// & 'Modelfiles (IDFs,IPFs,GENs) saved in the folder:'//CHAR(13)// & TRIM(DIR_DBS)//CHAR(13)//CHAR(13)// & 'Runfile (*.run) stored in the folder:,'//CHAR(13)// & TRIM(RUNFILE),'Information') ELSE WRITE(*,'(A)') 'Import Successfully completed.' WRITE(*,'(A)') 'Modelfiles (IDFs,IPFs,GENs) saved in the folder:' WRITE(*,'(A)') TRIM(DIR_DBS) WRITE(*,'(A)') 'Runfile (*.run) stored in the folder:,' ENDIF END FUNCTION IMPORT_CALC !###==================================================================== SUBROUTINE IMPORT_GETNAMES() !###==================================================================== IMPLICIT NONE INTEGER,PARAMETER :: MAXP=19 INTEGER :: I,J,IUNAM,NAMUNIT,IP,N CHARACTER(LEN=15) :: TXT CHARACTER(LEN=256) :: NAMFILE,LINE,ROOT CHARACTER(LEN=10),DIMENSION(MAXP) :: STXT INTEGER,DIMENSION(MAXP) :: ITXT DATA STXT/'BAS','BCF','DIS','LPF','WEL','DRN','RIV','RCH','GHB','EVT','PCG','OC','PTH','ANI','HUF','SCR','SFR','CHD','HFB'/ DATA ITXT/IBAS ,IBCF ,IDIS ,ILPF ,IWEL ,IDRN ,IRIV ,IRCH ,IGHB ,IEVT ,IPCG ,IOCD,IPTH, IANI, IHUF, ISCR, ISTR, ICHD, IHFB/ FNAME='' LEX=.TRUE. IF(MVERSION.EQ.1988)THEN !## check nam file !## model root. e.g. "model" or "scenario" NAMFILE=FNAME_MDL(:INDEX(FNAME_MDL,'.',.TRUE.)-1) INQUIRE(FILE=TRIM(NAMFILE)//'.NAM',EXIST=LEX) IF(.NOT.LEX)THEN DO I=0,MAXIUNIT; FNAME(I)=TRIM(NAMFILE)//'.'//TRIM(EXT(I)); ENDDO ELSE FNAME_MDL=TRIM(NAMFILE)//'.NAM' ENDIF ENDIF ROOT=FNAME_MDL(:INDEX(FNAME_MDL,'\',.TRUE.)-1) !## read nam file IF(LEX)THEN !## read nam file IUNAM=UTL_GETUNIT() CALL OSD_OPEN(IUNAM,FILE=FNAME_MDL,STATUS='OLD',ACTION='READ',IOSTAT=I) IF(I.NE.0)THEN CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot open file:'//CHAR(13)//TRIM(FNAME_MDL),'Error') RETURN ENDIF !## check modelinput DO I=1,SIZE(STXT) REWIND(IUNAM) DO READ(IUNAM,'(A256)',IOSTAT=J) LINE IF(J.NE.0)EXIT !## comment read, cycle IF(TRIM(LINE(1:1)).EQ.'#')CYCLE !## empty line IF(TRIM(LINE).EQ.'')CYCLE READ(LINE,*,IOSTAT=J) TXT,NAMUNIT,NAMFILE IF(J.NE.0)EXIT IP=-1 IF(TXT(1:3).EQ.TRIM(STXT(I)))IP=ITXT(I) IF(IP.NE.-1)THEN IF(INDEX(NAMFILE,'\').EQ.0)THEN FNAME(IP)=TRIM(ROOT)//'\'//TRIM(NAMFILE) ELSE FNAME(IP)=TRIM(NAMFILE) ENDIF EXIT ENDIF ENDDO ENDDO !## check data() keyword REWIND(IUNAM) N=0 DO READ(IUNAM,'(A256)',IOSTAT=J) LINE IF(J.NE.0)EXIT !## comment read, cycle IF(TRIM(LINE(1:1)).EQ.'#')CYCLE !## empty line IF(TRIM(LINE).EQ.'')CYCLE READ(LINE,*,IOSTAT=J) TXT,NAMUNIT,NAMFILE IF(J.NE.0)EXIT IF(TXT(1:4).EQ.'DATA')N=N+1 !.AND.TXT(1:5).NE.'DATA(')N=N+1 ENDDO IF(N.GT.0)THEN ALLOCATE(DATAF(N),DATAI(N)) N=0 REWIND(IUNAM) DO READ(IUNAM,'(A256)',IOSTAT=J) LINE IF(J.NE.0)EXIT !## comment read, cycle IF(TRIM(LINE(1:1)).EQ.'#')CYCLE !## empty line IF(TRIM(LINE).EQ.'')CYCLE READ(LINE,*,IOSTAT=J) TXT,NAMUNIT,NAMFILE IF(J.NE.0)EXIT IF(TXT(1:4).EQ.'DATA')THEN !.AND.TXT(1:5).NE.'DATA(')THEN N=N+1 IF(INDEX(NAMFILE,'\').EQ.0)THEN DATAF(N)=TRIM(ROOT)//'\'//TRIM(NAMFILE) ELSE DATAF(N)=NAMFILE ENDIF IF(INDEX(TXT,'BINARY').GT.0)NAMUNIT=-1*ABS(NAMUNIT) DATAI(N)=NAMUNIT ENDIF ENDDO ENDIF CLOSE(IUNAM) ENDIF ! IBAS=0 ! IBCF=1 ! IWEL=2 ! IDRN=3 ! IRIV=4 ! IEVT=5 ! !XXX= ! IGHB=7 ! IRCH=8 ! ISIP=9 ! !XXX= ! ISOR=11 ! IOCD=12 ! IPCG=13 ! IDIS=14 ! IHFB=15 ! ILPF=16 ! ICHD=17 ! IMOC=19 ! ITOP=20 ! IBOT=21 ! IPTH=22 ! IANI=23 ! IHUF=24 ! ISCR=25 ! IHDS=26 ! ISTR=27 !## open all files, knowing what is there! IFUNIT=0 DO I=0,MAXIUNIT; WRITE(*,'(I10,A)') I,','//TRIM(FNAME(I)); ENDDO DO I=0,MAXIUNIT; IF(IMPORT_OPENFILE(I))IFUNIT(I)=1; END DO !## open other units DO I=1,SIZE(DATAF) IF(DATAI(I).GT.0)THEN OPEN(DATAI(I),FILE=DATAF(I),STATUS='OLD',FORM='FORMATTED',ACTION='READ',IOSTAT=IOS) ELSEIF(DATAI(I).LE.0)THEN OPEN(ABS(DATAI(I)),FILE=DATAF(I),STATUS='OLD',FORM='UNFORMATTED',ACTION='READ',IOSTAT=IOS,ACCESS='stream') !SEQUENTIAL') ENDIF IF(IOS.NE.0)THEN DATAI(I)=0 WRITE(*,'(/A)') 'Cannot find file '//TRIM(DATAF(I)) ! CALL IMPORT_ERROR('Cannot open file: '//TRIM(DATAF(I)),IOS,DATAI(I)) ! RETURN ENDIF ENDDO END SUBROUTINE IMPORT_GETNAMES !###==================================================================== LOGICAL FUNCTION IMPORT_READCONFIG(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE INTEGER :: I,IROW,ICOL,NROW,NCOL,IBCFCB,LENUNI REAL(KIND=DP_KIND) :: MINCS,MAXCS,HDRY IMPORT_READCONFIG=.FALSE. IF(IFUNIT(IBAS).EQ.0)THEN CALL IMPORT_ERROR('Error Opening the BAS-file:'//CHAR(13)//TRIM(FNAME(IBAS))//CHAR(13)// & CHAR(13)//'Did you choose the right Modflow-version number ?',1,IU(IBAS)) RETURN ENDIF FREEFORMATTED=.FALSE. SELECT CASE (MVERSION) CASE (1988,1996) READ(IU(IBAS),*) !## heading1 READ(IU(IBAS),*) !## heading1 READ(IU(IBAS),'(5I10)',IOSTAT=IOS) NLAY,NROW,NCOL,NPER,ITMUNI IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading NLAY,NROW,NCOL,NPER,ITMUNI',IOS,IU(IBAS)) RETURN ENDIF LENUNI=2 !## meters IUNIT(0)=1 READ(IU(IBAS),'(A)') LINE !## key word that all data is free-formatted readin IF(INDEX(TRIM(UTL_CAP(LINE,'U')),'FREE').GT.0)FREEFORMATTED=.TRUE. IF(.NOT.FREEFORMATTED)THEN READ(LINE,'(99I3)',IOSTAT=IOS) (IUNIT(I),I=1,MAXIUNIT) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading IUNIT(.)',IOS,IU(IBAS)) RETURN ENDIF ENDIF READ(IU(IBAS),*) !## IAPART,ISTRT IF(IFUNIT(IBCF).EQ.0)THEN CALL IMPORT_ERROR('Error Opening the BCF-file:'//CHAR(13)//TRIM(FNAME(IBCF))//CHAR(13)// & CHAR(13)//'Did you choose the right Modflow-version number ?',1,IU(IBCF)) RETURN ENDIF CASE (2000,2005) CALL IMPORT_SKIPCOMMENTS(IU(IBAS)) READ(IU(IBAS),'(A)') LINE !## key word that all data is free-formatted readin IF(INDEX(TRIM(UTL_CAP(LINE,'U')),'FREE').GT.0)FREEFORMATTED=.TRUE. IF(IFUNIT(IDIS).EQ.0)THEN CALL IMPORT_ERROR('Error Opening the DIS-file:'//CHAR(13)//TRIM(FNAME(IDIS))//CHAR(13)// & CHAR(13)//'Did you choose the right Modflow-version number ?',1,IU(IDIS)) RETURN ENDIF CALL IMPORT_SKIPCOMMENTS(IU(IDIS)) LENUNI=2 IF(MVERSION.EQ.2000)READ(IU(IDIS),*,IOSTAT=IOS) NLAY,NROW,NCOL,NPER,ITMUNI IF(MVERSION.EQ.2005)READ(IU(IDIS),*,IOSTAT=IOS) NLAY,NROW,NCOL,NPER,ITMUNI,LENUNI IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading NLAY,NROW,NCOL,NPER,ITMUNI,LENUNI',IOS,IU(IDIS)) RETURN ENDIF ALLOCATE(DELR(NCOL),DELC(NROW),LAYCBD(NLAY)) READ(IU(IDIS),'(99I2)',IOSTAT=IOS) (LAYCBD(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYCBD(.)',IOS,IU(IDIS)) RETURN ENDIF IF(.NOT.IMPORT_READU2DREL(IU(IDIS),DELR,NCOL,1,'DELR'))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IDIS),DELC,NROW,1,'DELC'))RETURN END SELECT SELECT CASE (ITMUNI) CASE (0) STOP 'ITMUNI EQ 0 IN *.dis file --- specify units' CASE (1); FT=1.0D0/(60.0D0*60.0D0*24.0) !## seconds -> days CASE (2); FT=1.0D0/(60.0D0*24.0) !## minutes -> days CASE (3); FT=1.0D0/(24.0) !## hours -> days CASE (4); FT=1.0D0 !## days CASE (5); FT=365.25 !## years -> days END SELECT SELECT CASE (LENUNI) CASE (0) STOP 'LENUNI EQ 0 IN *.dis file --- specify units' CASE (1); FL=0.3048 !## feet -> meter CASE (2); FL=1.0D0 !## meters CASE (3); FL=0.01D0 !## centimeters -> meter END SELECT IF(IFUNIT(IBCF).EQ.1)THEN SELECT CASE (MVERSION) CASE (1988) READ(IU(IBCF),'(2I10,F10.0,I10)',IOSTAT=IOS) ISS,IBCFCB,HDRY,IWDFLG ISS=ABS(ISS-1) CASE DEFAULT IF(.NOT.FREEFORMATTED)THEN READ(IU(IBCF),'(I10,F10.0,I10)',IOSTAT=IOS) IBCFCB,HDRY,IWDFLG ENDIF IF(FREEFORMATTED)READ(IU(IBCF),*,IOSTAT=IOS) IBCFCB,HDRY,IWDFLG IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading ISS',IOS,IU(IBCF)) RETURN ENDIF END SELECT IF(.NOT.ALLOCATED(DELR))ALLOCATE(DELR(NCOL)) IF(.NOT.ALLOCATED(DELC))ALLOCATE(DELC(NROW)) ALLOCATE(LAYCON(NLAY),TRPY(NLAY)) READ(IU(IBCF),'(99I2)',IOSTAT=IOS) (LAYCON(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYCON(.)',IOS,IU(IBCF)) RETURN ENDIF IF(.NOT.IMPORT_READU2DREL(IU(IBCF),TRPY,NLAY,1,'TRPY'))RETURN IF(MVERSION.EQ.1988.OR.MVERSION.EQ.1996)THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),DELR,NCOL,1,'DELR'))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),DELC,NROW,1,'DELC'))RETURN ENDIF ENDIF !## correct cellsize into meters DELR=DELR*FL DELC=DELC*FL ALLOCATE(TPER(0:NPER),DTPER(NPER),NSTP(NPER),TSMULT(NPER)) !## allocate idf (mother) CALL IDFNULLIFY(IDF) IDF%NCOL=NCOL; IDF%NROW=NROW IDF%XMIN=XMIN; IDF%YMIN=YMIN YMAX=YMIN+SUM(DELC); IDF%YMAX=YMAX IDF%XMAX=XMIN+SUM(DELR) MINCS=MIN(MINVAL(DELR(1:NCOL)),MINVAL(DELC(1:NROW))) MAXCS=MAX(MAXVAL(DELR(1:NCOL)),MAXVAL(DELC(1:NROW))) IF(.NOT.IDFALLOCATEX(IDF))RETURN IDF%IEQ =0 IF(MINCS.NE.MAXCS)THEN IDF%IEQ=1 IF(.NOT.IDFALLOCATESXY(IDF))RETURN IDF%SX(0)=IDF%XMIN DO ICOL=1,NCOL; IDF%SX(ICOL)=IDF%SX(ICOL-1)+DELR(ICOL); END DO IDF%SY(0)=IDF%YMAX DO IROW=1,NROW; IDF%SY(IROW)=IDF%SY(IROW-1)-DELC(IROW); END DO ELSE !## recompute xmax and ymax to be more accurate IDF%XMAX=IDF%XMIN+REAL(NCOL)*IDF%DX IDF%YMAX=IDF%YMIN+REAL(NROW)*IDF%DY ENDIF IDF%DX=MINCS; IDF%DY=MINCS IF(IITYPE.EQ.1)WRITE(IURUN,'(A)') TRIM(DIR_DBS)//'\RESULTS' !## get units to be truly available IUNIT=IFUNIT IMPORT_READCONFIG=.TRUE. END FUNCTION IMPORT_READCONFIG !###==================================================================== SUBROUTINE IMPORT_SKIPCOMMENTS(I) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: I CHARACTER(LEN=12) :: TXT DO READ(I,'(A12)') TXT IF(TXT(1:1).NE.'#'.AND.TXT(1:1).NE.'!'.AND. & TXT(1:9).NE.'PARAMETER')EXIT ENDDO BACKSPACE(I) END SUBROUTINE IMPORT_SKIPCOMMENTS !###==================================================================== LOGICAL FUNCTION IMPORT_PCG(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE CHARACTER(LEN=256) :: LINE IMPORT_PCG=.FALSE. IF(IU(IPCG).EQ.0)THEN MAXITER=500; NITER=20; HCLOSE=0.001D0; RCLOSE=1.0D0; RELAX=0.98D0 ELSE IF(FREEFORMATTED)THEN DO READ(IU(IPCG),'(A256)') LINE IF(LINE(1:1).NE.'#')EXIT ENDDO READ(LINE,*) MAXITER,NITER READ(IU(IPCG),*) HCLOSE,RCLOSE,RELAX ELSE READ(IU(IPCG),'(2I10)') MAXITER,NITER READ(IU(IPCG),'(3F10.0)') HCLOSE,RCLOSE,RELAX ENDIF ENDIF IF(IITYPE.EQ.1)THEN WRITE(IURUN,'(2I10,3(E10.3,1X))') MAXITER,NITER,HCLOSE,RCLOSE,RELAX ELSE WRITE(IURUN,'(/A)') '1,(PCG),1' WRITE(IURUN,'(A)') 'MXITER='//TRIM(VTOS(MAXITER)) WRITE(IURUN,'(A)') 'ITER1='//TRIM(VTOS(NITER)) WRITE(IURUN,'(A)') 'HCLOSE='//TRIM(VTOS(HCLOSE,'G',7)) WRITE(IURUN,'(A)') 'RCLOSE='//TRIM(VTOS(RCLOSE,'G',7)) WRITE(IURUN,'(A)') 'RELAX='//TRIM(VTOS(RELAX,'G',7)) WRITE(IURUN,'(A)') 'NPCOND=1' WRITE(IURUN,'(A)') 'IPRPCG=0' WRITE(IURUN,'(A)') 'MUTPCG=1' WRITE(IURUN,'(A)') 'DAMPPCG=1.0' WRITE(IURUN,'(A)') 'DAMPPCGT=1.0' WRITE(IURUN,'(A)') 'IQERROR=0' WRITE(IURUN,'(A)') 'QERROR=0.0' ENDIF IMPORT_PCG=.TRUE. END FUNCTION IMPORT_PCG !###==================================================================== LOGICAL FUNCTION IMPORT_BAS() !###==================================================================== IMPLICIT NONE INTEGER :: IROW,ICOL IMPORT_BAS=.FALSE. DO ILAY=1,NLAY IF(.NOT.IMPORT_READU2DINT(IU(IBAS),IDF%X,IDF%NCOL,IDF%NROW,'BOUNDARY CONDITIONS'))RETURN LINE=TRIM(DIR_DBS)//'\BND\VERSION_1\BND_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO ALLOCATE(BAS(NLAY)) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\BND\VERSION_1\BND_L'//TRIM(VTOS(ILAY))//'.IDF' LEX=IMPORT_READ_IDF(BAS(ILAY),LINE) ENDDO READ(IU(IBAS),*) HNOFLOW DO ILAY=1,NLAY IF(.NOT.IMPORT_READU2DREL(IU(IBAS),IDF%X,IDF%NCOL,IDF%NROW,'SHD'))RETURN LINE=TRIM(DIR_DBS)//'\SHD\VERSION_1\SHD_L'//TRIM(VTOS(ILAY))//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO ! IDF%X=FL*IDF%X CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO !## read in *.bas file IF(MVERSION.EQ.1988.OR.MVERSION.EQ.1996)THEN TPER(0)=SDATE DO IPER=1,NPER READ(IU(IBAS),'(F10.0,I10,F10.0)') DTPER(IPER),NSTP(IPER),TSMULT(IPER) TPER(IPER)=TPER(IPER-1)+INT(DTPER(IPER)) END DO ENDIF NSTP=1.0D0 TSMULT=1.0D0 IMPORT_BAS=.TRUE. END FUNCTION IMPORT_BAS !###==================================================================== SUBROUTINE IMPORT_READBASINRUNFILE(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY))//',(BND)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(BND),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\BND\VERSION_1\BND_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0,0.0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0,0.0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY))//',(SHD)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(SHD),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\SHD\VERSION_1\SHD_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0,0.0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0,0.0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO END SUBROUTINE IMPORT_READBASINRUNFILE !###==================================================================== LOGICAL FUNCTION IMPORT_BAS_CHDCORRECTION() !###==================================================================== IMPLICIT NONE INTEGER :: ICOL,IROW,I LOGICAL :: LEX IMPORT_BAS_CHDCORRECTION=.TRUE. IF(IFUNIT(ICHD).EQ.0)RETURN IMPORT_BAS_CHDCORRECTION=.FALSE. ALLOCATE(CHD(NLAY)); DO I=1,SIZE(CHD); CALL IDFNULLIFY(CHD(I)); ENDDO DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\BND\VERSION_1\BND_L'//TRIM(VTOS(ILAY))//'.IDF' LEX=IMPORT_READ_IDF(BAS(ILAY),LINE) ENDDO DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\CHD\VERSION_1\CHD_STAGE_'//TRIM(LONGDATE1)//'_L'//TRIM(VTOS(ILAY))//'.IDF' ! TRIM(VTOS(UTL_JDATETOIDATE(TPER(0))))//'_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IMPORT_READ_IDF(CHD(ILAY),LINE))THEN DO IROW=1,IDF%NROW DO ICOL=1,IDF%NCOL IF(CHD(ILAY)%X(ICOL,IROW).NE.CHD(ILAY)%NODATA)BAS(ILAY)%X(ICOL,IROW)=-2 END DO END DO ENDIF END DO DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\BND\VERSION_1\BND_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,BAS(ILAY)))RETURN ENDDO CALL IDFDEALLOCATE(CHD,SIZE(CHD)); DEALLOCATE(CHD) IMPORT_BAS_CHDCORRECTION=.TRUE. END FUNCTION IMPORT_BAS_CHDCORRECTION !###==================================================================== LOGICAL FUNCTION IMPORT_BCF(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE INTEGER :: IROW,ICOL,I IMPORT_BCF=.FALSE. IF(IFUNIT(IBCF).EQ.0)RETURN DO ILAY=1,NLAY IF(ISS.EQ.1)THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'STO'))RETURN CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\STO\VERSION_1\STO_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF SELECT CASE (LAYCON(ILAY)) CASE (0,2) IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'KDW'))RETURN DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=(FL**2)/FT*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\KDW\VERSION_1\KDW_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN CASE (1,3) IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'KHV'))RETURN DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL/FT*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\KHV\VERSION_1\KHV_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(MVERSION.EQ.1988)THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'BOTTOM'))RETURN IDF%X=FL*IDF%X DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\BOT\VERSION_1\BOT_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF END SELECT IF(ILAY.LT.NLAY)THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'VCW'))RETURN LINE=TRIM(DIR_DBS)//'\VCW\VERSION_1\VCW_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_BCF_VCONT2C() DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FT*IDF%X(ICOL,IROW) ENDDO; ENDDO IDF%NODATA=-999.9D0 !0.0D0 CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(ISS.EQ.1.AND.(LAYCON(ILAY).EQ.2.OR.LAYCON(ILAY).EQ.3))THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'SF2'))RETURN CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\SF2\VERSION_1\SF2_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF SELECT CASE (LAYCON(ILAY)) CASE (2,3) IF(MVERSION.EQ.1988)THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'TOP'))RETURN DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF END SELECT IF(IWDFLG.EQ.1.AND.(LAYCON(ILAY).EQ.1.OR.LAYCON(ILAY).EQ.3))THEN IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'WETDRY'))RETURN CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\WETDRY\VERSION_1\WETDRY_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDDO I=0; DO ILAY=1,NLAY !## usage of KHV IF(LAYCON(ILAY).EQ.1)I=1 ENDDO CALL IMPORT_EXPORT_LPFHUFBCF(I,IITYPE) IMPORT_BCF=.TRUE. END FUNCTION IMPORT_BCF !###==================================================================== SUBROUTINE IMPORT_CORRECT4IBOUND() !###==================================================================== IMPLICIT NONE INTEGER :: IROW,ICOL DO IROW=1,IDF%NROW DO ICOL=1,IDF%NCOL IF(BAS(ILAY)%X(ICOL,IROW).EQ.0)THEN IDF%X(ICOL,IROW)=IDF%NODATA ENDIF ENDDO ENDDO END SUBROUTINE IMPORT_CORRECT4IBOUND !###==================================================================== LOGICAL FUNCTION IMPORT_BCF_CORRECTION() !###==================================================================== IMPLICIT NONE INTEGER :: ICOL,IROW,I LOGICAL,DIMENSION(:),ALLOCATABLE :: LH,LK,LTOP,LBOT,LVA,LPSC,LKD,LC,LS,LVK REAL(KIND=DP_KIND) :: C1,C2 IMPORT_BCF_CORRECTION=.FALSE. ALLOCATE(H(NLAY) ,K(NLAY) ,TOP(NLAY) ,BOT(NLAY), VA(NLAY), PSC(NLAY), KD(NLAY), C(NLAY), S(NLAY), VK(NLAY)) ALLOCATE(LH(NLAY),LK(NLAY),LTOP(NLAY),LBOT(NLAY),LVA(NLAY),LPSC(NLAY),LKD(NLAY),LC(NLAY),LS(NLAY),LVK(NLAY)) !## nullify all DO I=1,NLAY CALL IDFNULLIFY(H(I)) CALL IDFNULLIFY(K(I)) CALL IDFNULLIFY(C(I)) CALL IDFNULLIFY(S(I)) CALL IDFNULLIFY(TOP(I)) CALL IDFNULLIFY(BOT(I)) CALL IDFNULLIFY(VA(I)) CALL IDFNULLIFY(VK(I)) CALL IDFNULLIFY(KD(I)) CALL IDFNULLIFY(PSC(I)) ENDDO DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\SHD\VERSION_1\SHD_L'//TRIM(VTOS(ILAY))//'.IDF' LH(ILAY) =IMPORT_READ_IDF(H(ILAY),LINE) LKD(ILAY)=IMPORT_READ_IDF(KD(ILAY),LINE) LC(ILAY) =IMPORT_READ_IDF(C(ILAY) ,LINE) LS(ILAY) =IMPORT_READ_IDF(S(ILAY) ,LINE) LINE=TRIM(DIR_DBS)//'\KHV\VERSION_1\KHV_L'//TRIM(VTOS(ILAY))//'.IDF' LK(ILAY) =IMPORT_READ_IDF(K(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\KVV\VERSION_1\KVV_L'//TRIM(VTOS(ILAY))//'.IDF' LVK(ILAY) =IMPORT_READ_IDF(VK(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\KVA\VERSION_1\KVA_L'//TRIM(VTOS(ILAY))//'.IDF' LVA(ILAY) =IMPORT_READ_IDF(VA(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\STO\VERSION_1\STO_L'//TRIM(VTOS(ILAY))//'.IDF' LPSC(ILAY)=IMPORT_READ_IDF(PSC(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(ILAY))//'.IDF' LTOP(ILAY)=IMPORT_READ_IDF(TOP(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\BOT\VERSION_1\BOT_L'//TRIM(VTOS(ILAY))//'.IDF' LBOT(ILAY)=IMPORT_READ_IDF(BOT(ILAY),LINE) ENDDO KD%NODATA=0.0D0 C%NODATA =0.0D0 S%NODATA =0.0D0 LKD=.FALSE. LC =.FALSE. LS =.FALSE. DO IROW=1,IDF%NROW DO ICOL=1,IDF%NCOL DO ILAY=1,NLAY KD(ILAY)%X(ICOL,IROW)=KD(ILAY)%NODATA C(ILAY)%X(ICOL,IROW) =C(ILAY)%NODATA S(ILAY)%X(ICOL,IROW) =S(ILAY)%NODATA IF(LPSC(ILAY))THEN IF(LTOP(ILAY).AND.LBOT(ILAY))THEN S(ILAY)%X(ICOL,IROW)=PSC(ILAY)%X(ICOL,IROW)*(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)) LS(ILAY)=.TRUE. ELSE CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Missing top/bottom for layer '//TRIM(VTOS(ILAY))// & ' for comp. storage coefficient! ','Error') RETURN ENDIF ENDIF IF(LK(ILAY))THEN IF(LTOP(ILAY).AND.LBOT(ILAY))THEN LKD(ILAY)=.TRUE. KD(ILAY)%X(ICOL,IROW)=K(ILAY)%X(ICOL,IROW)*(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)) ELSEIF(.NOT.LTOP(ILAY).AND.LBOT(ILAY))THEN IF(ILAY.GT.1)THEN LKD(ILAY)=.TRUE. KD(ILAY)%X(ICOL,IROW)=K(ILAY)%X(ICOL,IROW)*(BOT(ILAY-1)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)) ENDIF ELSE CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Missing top/bottom for layer '//TRIM(VTOS(ILAY))// & ' for comp. KDW! ','Error') RETURN ENDIF ENDIF IF(ILAY.LT.NLAY)THEN !## vertical conductance IF(LVK(ILAY))THEN LC(ILAY)=.TRUE. C1=0.0D0 IF(VK(ILAY)%X(ICOL,IROW).GT.0.0D0)THEN IF(LTOP(ILAY))THEN C1=(0.5*(TOP(ILAY )%X(ICOL,IROW)-BOT(ILAY )%X(ICOL,IROW)))/(VK(ILAY)%X(ICOL,IROW)) ELSE C1=(0.5*(BOT(ILAY-1)%X(ICOL,IROW)-BOT(ILAY )%X(ICOL,IROW)))/(VK(ILAY)%X(ICOL,IROW)) ENDIF ENDIF C2=0.0D0 IF(VK(ILAY+1)%X(ICOL,IROW).GT.0.0D0)THEN IF(LTOP(ILAY+1))THEN C2=(0.5*(TOP(ILAY+1)%X(ICOL,IROW)-BOT(ILAY+1)%X(ICOL,IROW)))/(VK(ILAY+1)%X(ICOL,IROW)) ELSE C2=(0.5*(BOT(ILAY )%X(ICOL,IROW)-BOT(ILAY+1)%X(ICOL,IROW)))/(VK(ILAY+1)%X(ICOL,IROW)) ENDIF ENDIF C(ILAY)%X(ICOL,IROW)=C1+C2 ENDIF IF(LVA(ILAY))THEN LC(ILAY)=.TRUE. C(ILAY)%X(ICOL,IROW)= (0.5*(TOP(ILAY)%X(ICOL,IROW)-BOT(ILAY)%X(ICOL,IROW)))/ & (K(ILAY)%X(ICOL,IROW)*VA(ILAY)%X(ICOL,IROW)) C(ILAY)%X(ICOL,IROW)=C(ILAY)%X(ICOL,IROW)+ & (0.5*(TOP(ILAY+1)%X(ICOL,IROW)-BOT(ILAY+1)%X(ICOL,IROW)))/ & (K(ILAY+1)%X(ICOL,IROW)*VA(ILAY+1)%X(ICOL,IROW)) ENDIF ENDIF END DO END DO END DO DO ILAY=1,NLAY IF(LKD(ILAY))THEN LINE=TRIM(DIR_DBS)//'\KDW\VERSION_1\KDW_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,KD(ILAY)))RETURN ENDIF IF(LC(ILAY))THEN LINE=TRIM(DIR_DBS)//'\VCW\VERSION_1\VCW_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,C(ILAY)))RETURN ENDIF IF(LS(ILAY))THEN LINE=TRIM(DIR_DBS)//'\STO\VERSION_1\STO_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,S(ILAY)))RETURN ENDIF ENDDO DEALLOCATE(LH,LK,LTOP,LBOT,LVA,LPSC,LKD,LC,LS,LVK) IF(ALLOCATED(H)) CALL IDFDEALLOCATE(H,SIZE(H)) IF(ALLOCATED(K)) CALL IDFDEALLOCATE(K,SIZE(K)) IF(ALLOCATED(TOP))CALL IDFDEALLOCATE(TOP,SIZE(TOP)) IF(ALLOCATED(BOT))CALL IDFDEALLOCATE(BOT,SIZE(BOT)) IF(ALLOCATED(VA)) CALL IDFDEALLOCATE(VA,SIZE(VA)) IF(ALLOCATED(PSC))CALL IDFDEALLOCATE(PSC,SIZE(PSC)) IF(ALLOCATED(KD)) CALL IDFDEALLOCATE(KD,SIZE(KD)) IF(ALLOCATED(C)) CALL IDFDEALLOCATE(C,SIZE(C)) IF(ALLOCATED(S)) CALL IDFDEALLOCATE(S,SIZE(S)) IF(ALLOCATED(VK)) CALL IDFDEALLOCATE(VK,SIZE(VK)) DEALLOCATE(H,K,TOP,BOT,VA,PSC,KD,C,S,VK) IMPORT_BCF_CORRECTION=.TRUE. END FUNCTION IMPORT_BCF_CORRECTION !###==================================================================== LOGICAL FUNCTION IMPORT_READ_IDF(IDF,FNAME) !###==================================================================== IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) :: FNAME TYPE(IDFOBJ),INTENT(INOUT) :: IDF INQUIRE(FILE=FNAME,EXIST=IMPORT_READ_IDF) IF(.NOT.IMPORT_READ_IDF)RETURN IF(IBATCH.EQ.0)CALL WINDOWOUTSTATUSBAR(4,'Reading '//TRIM(FNAME)//' ...') IF(IBATCH.EQ.1)WRITE(*,'(A)') 'Reading '//TRIM(FNAME)//' ...' IDF%IXV =0 IMPORT_READ_IDF=IDFREAD(IDF,FNAME,1) END FUNCTION IMPORT_READ_IDF !###==================================================================== LOGICAL FUNCTION IMPORT_ANI() !###==================================================================== IMPLICIT NONE IMPORT_ANI=.TRUE. IF(IFUNIT(IANI).EQ.0)RETURN IMPORT_ANI=.FALSE. DO ILAY=1,NLAY IF(.NOT.IMPORT_READU2DREL(IU(IANI),IDF%X,IDF%NCOL,IDF%NROW,'ANI_FACTOR'))RETURN LINE=TRIM(DIR_DBS)//'\ANISOTROPY\VERSION_1\ANI_FACTOR_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IANI),IDF%X,IDF%NCOL,IDF%NROW,'ANI_HOEK'))RETURN LINE=TRIM(DIR_DBS)//'\ANISOTROPY\VERSION_1\ANI_HOEK_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO LINE=TRIM(VTOS(NLAY))//',(ani)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\ANISOTROPY\VERSION_1\ANI_FACTOR_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\ANISOTROPY\VERSION_1\ANI_HOEK_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IMPORT_ANI=.TRUE. END FUNCTION IMPORT_ANI !###==================================================================== LOGICAL FUNCTION IMPORT_LPF(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE INTEGER :: ILPFCB,NPLPF,I,J,IROW,ICOL REAL(KIND=DP_KIND) :: HDRY,PARVAL INTEGER :: NCLU CHARACTER(LEN=52) :: PARNAM,PARTYP IMPORT_LPF=.FALSE. IF(IFUNIT(ILPF).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(ILPF)) ALLOCATE(LAYTYPE(NLAY),LAYAVG(NLAY),CHANI(NLAY),LAYVKA(NLAY),LAYWET(NLAY)) READ(IU(ILPF),*,IOSTAT=IOS) ILPFCB,HDRY,NPLPF IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading ILPFCB,HDRY,NPLPF',IOS,IU(ILPF)) RETURN ENDIF READ(IU(ILPF),*,IOSTAT=IOS) (LAYTYPE(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYTYPE',IOS,IU(ILPF)) RETURN !## 0=confined;<>0=convertible ENDIF READ(IU(ILPF),*,IOSTAT=IOS) (LAYAVG(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYAVG',IOS,IU(ILPF)) RETURN !## contains a flag for each layer that defines the ENDIF ! method of calculating interblock KDW !## 0=harmonic mean (This is most appropriate for confined and unconfined aquifers with abrupt boundaries in ! KDW at the cell boundaries or for confined aquifers with uniform hydraulic conductivity.) !## 1=logarithmic mean (This is most appropriate for confined aquifers with gradually varying transmissivities.) !## 2=arithmetic mean of saturated thickness and logarithmic-mean hydraulic conductivity. (This is most appropriate ! for unconfined aquifers with gradually varying transmissivities.) READ(IU(ILPF),*,IOSTAT=IOS) (CHANI(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading CHANI',IOS,IU(ILPF)) RETURN ENDIF !## contains a value for each layer that is a flag or the hor. ani. !## <=0 then variable HANI defines horizontal anisotropy. !## >0 then CHANI is the horizontal anisotropy for the entire layer, and HANI is not read READ(IU(ILPF),*,IOSTAT=IOS) (LAYVKA(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYVKA',IOS,IU(ILPF)) RETURN ENDIF !## contains a flag for each layer that indicates variable VKA is !## 0 indicates VKA is vertical hydraulic conductivity !## <>0 indicates VKA is the ratio of horizontal to vertical hydraulic conductivity, where the horizontal hydraulic conductivity ! is specified as HK in item 10. READ(IU(ILPF),*,IOSTAT=IOS) (LAYWET(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYWET',IOS,IU(ILPF)) RETURN ENDIF !## contains a flag for each layer that indicates if wetting is active !## 0 indicates wetting is inactive !## <>0 indicates wetting is active !## read wettable layers IF(SUM(LAYWET).NE.0)THEN READ(IU(ILPF),*,IOSTAT=IOS) !WETFCT,IWETIT,IHDWET !## nothing done with IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYWET',IOS,IU(ILPF)) RETURN ENDIF ENDIF !## do something when this is bigger DO J=1,NPLPF READ(IU(ILPF),*) PARNAM,PARTYP,PARVAL,NCLU DO I=1,NCLU READ(IU(ILPF),*) ![Layer Mltarr Zonarr IZ ENDDO ENDDO DO ILAY=1,NLAY IF(IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'KHV'))THEN LINE=TRIM(DIR_DBS)//'\KHV\VERSION_1\KHV_L'//TRIM(VTOS(ILAY))//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*FT*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(CHANI(ILAY).LE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'ANI'))RETURN LINE=TRIM(DIR_DBS)//'\ANI\VERSION_1\ANI_FACTOR_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(LAYVKA(ILAY).EQ.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'KVV'))RETURN LINE=TRIM(DIR_DBS)//'\KVV\VERSION_1\KVV_L'//TRIM(VTOS(ILAY))//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*FT*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ELSE IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'KVA'))RETURN LINE=TRIM(DIR_DBS)//'\KVA\VERSION_1\KVA_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(ISS.EQ.1)THEN IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'STO'))RETURN LINE=TRIM(DIR_DBS)//'\STO\VERSION_1\STO_L'// & TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(LAYTYPE(ILAY).NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'SF2'))RETURN LINE=TRIM(DIR_DBS)//'\SF2\VERSION_1\SF2_L'// & TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDIF IF(LAYCBD(ILAY).NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'KVV'))RETURN LINE=TRIM(DIR_DBS)//'\KVV\VERSION_1\KVV_L'//TRIM(VTOS(ILAY))//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*FT*IDF%X(ICOL,IROW) ENDDO; ENDDO CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(LAYWET(ILAY).NE.0.AND.LAYTYPE(ILAY).NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ILPF),IDF%X,IDF%NCOL,IDF%NROW,'WETDRY'))RETURN LINE=TRIM(DIR_DBS)//'\WETDRY\VERSION_1\WETDRY_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDDO ! I=0; DO ILAY=1,NLAY ! !## usage of KHV ! IF(LAYTYPE(ILAY).EQ.1)I=1 ! ENDDO I=1 CALL IMPORT_EXPORT_LPFHUFBCF(I,IITYPE) IMPORT_LPF=.TRUE. END FUNCTION IMPORT_LPF !###==================================================================== SUBROUTINE IMPORT_EXPORT_LPFHUFBCF(LAYCON,IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE,LAYCON IF(LAYCON.EQ.0)THEN IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY))//',(KDW)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(KDW),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\KDW\VERSION_1\KDW_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO ENDIF IF(LAYCON.EQ.1)THEN IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY))//',(TOP)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(TOP),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY))//',(BOT)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(BOT),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\BOT\VERSION_1\BOT_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY))//',(KHV)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(KHV),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\KHV\VERSION_1\KHV_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO ENDIF IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY-1))//',(VCW)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(VCW),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY-1 LINE=TRIM(DIR_DBS)//'\VCW\VERSION_1\VCW_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(ISS.EQ.1)THEN IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(NLAY-1))//',(STO)' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE='1,(STO),1'; WRITE(IURUN,'(/A)') TRIM(LINE) LINE='1,'//TRIM(VTOS(NLAY)); WRITE(IURUN,'(A)') TRIM(LINE) ENDIF DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\STO\VERSION_1\STO_L'//TRIM(VTOS(ILAY))//'.IDF' IF(IITYPE.EQ.1)THEN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE LINE='1,2,'//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,-999.0,"'//TRIM(LINE)//'"' ENDIF WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO ENDIF END SUBROUTINE IMPORT_EXPORT_LPFHUFBCF !###==================================================================== LOGICAL FUNCTION IMPORT_HUF(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE INTEGER :: IHUFCB,NHUF,NPHUF,IOHUFHEADS,I,IROW,ICOL REAL(KIND=DP_KIND) :: HDRY IMPORT_HUF=.FALSE. IF(IFUNIT(IHUF).EQ.0)RETURN ! IF(.NOT.IMPORT_OPENFILE(IHUF))RETURN CALL IMPORT_SKIPCOMMENTS(IU(IHUF)) ALLOCATE(LAYWT(NLAY),LTHUF(NLAY)) READ(IU(IHUF),*,IOSTAT=IOS) IHUFCB,HDRY,NHUF,NPHUF,IOHUFHEADS IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading IHUFCB,HDRY,NHUF,NPHUF,IOHUFHEADS',IOS,IU(IHUF)) RETURN ENDIF READ(IU(IHUF),*,IOSTAT=IOS) (LTHUF(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LTHUF',IOS,IU(IHUF)) RETURN !## 0=confined layer, 1=convertible layer ENDIF READ(IU(IHUF),*,IOSTAT=IOS) (LAYWT(ILAY),ILAY=1,NLAY) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading LAYWT',IOS,IU(IHUF)) RETURN !## (re)wetting ENDIF !## read wetting options IF(SUM(LAYWT).GT.0)THEN ENDIF DO I=1,NHUF READ(IU(IHUF),*,IOSTAT=IOS) !HGUNAM IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading HGUNAM',IOS,IU(IHUF)) RETURN ENDIF IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'TOP'))RETURN ! IDF%X=FL*IDF%X DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(I))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'THK'))RETURN ! IDF%X=FL*IDF%X DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\THK\VERSION_1\THK_L'//TRIM(VTOS(I))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN END DO !## assuming horizontal anisotropy in HANI and vertical anisotropy to be constant for entire layer DO I=1,NHUF READ(IU(IHUF),*,IOSTAT=IOS) !HGUNAM IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading HGUNAM',IOS,IU(IHUF)) RETURN ENDIF ! ENDDO ! READ(IU(ILPF),*,IOSTAT=IOS) (CHANI(ILAY),ILAY=1,NLAY) ! IF(.NOT.IMPORT_ERROR('Error reading CHANI',IOS,IU(ILPF)))RETURN ! READ(IU(ILPF),*,IOSTAT=IOS) (LAYVKA(ILAY),ILAY=1,NLAY) ! IF(.NOT.IMPORT_ERROR('Error reading LAYVKA',IOS,IU(ILPF)))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'KHV'))RETURN ! IDF%X=FL/FT*IDF%X DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL/FT*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\KHV\VERSION_1\KHV_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(CHANI(ILAY).LE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'ANISOTROPY'))RETURN LINE=TRIM(DIR_DBS)//'\ANI\VERSION_1\ANI_FACTOR_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(LAYVKA(ILAY).EQ.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'KVV'))RETURN ! IDF%X=FL/FT*IDF%X DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL/FT*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\KVV\VERSION_1\KVV_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ELSE IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'KVA'))RETURN LINE=TRIM(DIR_DBS)//'\KVA\VERSION_1\KVA_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(ISS.EQ.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'STO'))RETURN LINE=TRIM(DIR_DBS)//'\STO\VERSION_1\STO_L'// & TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(LAYCBD(ILAY).NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'KVV'))RETURN ! IDF%X=FL/FT*IDF%X DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL/FT*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\KVV\VERSION_1\KVV_L'//TRIM(VTOS(ILAY))//'.IDF' ! CALL IMPORT_BCF_VCONT2C() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(LAYWET(ILAY).NE.0.AND.LAYTYPE(ILAY).NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'WDR'))RETURN LINE=TRIM(DIR_DBS)//'\WDR\VERSION_1\WDR_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDDO ! CALL IMPORT_EXPORT_LPFHUFBCF(LAYTYPE,IITYPE) IMPORT_HUF=.TRUE. END FUNCTION IMPORT_HUF !###==================================================================== LOGICAL FUNCTION IMPORT_DIS() !###==================================================================== IMPLICIT NONE CHARACTER(LEN=2) :: TXT INTEGER :: IROW,ICOL IMPORT_DIS=.TRUE. !## no usage of dis-files for 1988/1996 IF(MVERSION.EQ.1988.OR.MVERSION.EQ.1996)RETURN IMPORT_DIS=.FALSE. IF(.NOT.IMPORT_READU2DREL(IU(IDIS),IDF%X,IDF%NCOL,IDF%NROW,'TOP'))RETURN LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(1))//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO ILAY=1; CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN DO ILAY=1,NLAY IF(.NOT.IMPORT_READU2DREL(IU(IDIS),IDF%X,IDF%NCOL,IDF%NROW,'BOT'))RETURN DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\BOT\VERSION_1\BOT_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN !## bottom confining beds IF(LAYCBD(ILAY).NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IDIS),IDF%X,IDF%NCOL,IDF%NROW,'TOP'))RETURN DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(ILAY+1))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ELSE !## top is equal to bottom IF(ILAY.LT.NLAY)THEN LINE=TRIM(DIR_DBS)//'\TOP\VERSION_1\TOP_L'//TRIM(VTOS(ILAY+1))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDIF END DO TPER(0)=SDATE DO IPER=1,NPER READ(IU(IDIS),*) DTPER(IPER),NSTP(IPER),TSMULT(IPER),TXT !## steady-state IF(UTL_CAP(TXT,'U').EQ.'SS')THEN DTPER(IPER)=0.0D0 ISS=0 ELSEIF(UTL_CAP(TXT,'U').EQ.'TR')THEN DTPER(IPER)=DTPER(IPER)*FT ISS=1 ENDIF IF(ISS.NE.1.AND.ISS.NE.0)THEN CALL IMPORT_ERROR('Error reading TIME-INFORMATION',-1,IU(IDIS)) RETURN !## (re)wetting ENDIF TPER(IPER)=TPER(IPER-1)+DTPER(IPER) END DO IMPORT_DIS=.TRUE. END FUNCTION IMPORT_DIS !###==================================================================== LOGICAL FUNCTION IMPORT_SCR() !###==================================================================== IMPLICIT NONE INTEGER :: ISCRCB,ISCROC,NSYSTM,NOBSSUB,ITHK,IVOID,IMETHOD,ISTPCS, & IZCFL,IZCFM,IGLFL,IGLFM,IESTFL,IESTFM,IPCSFL,IPCSFM REAL(KIND=DP_KIND) :: ALPHA,I,IROW,ICOL INTEGER,DIMENSION(:),ALLOCATABLE :: LNWT INTEGER :: ISYS IMPORT_SCR=.FALSE. IF(IFUNIT(ISCR).EQ.0)THEN; IMPORT_SCR=.TRUE.; RETURN; ENDIF CALL IMPORT_SKIPCOMMENTS(IU(ISCR)) READ(IU(ISCR),*,IOSTAT=IOS) ISCRCB,ISCROC,NSYSTM,NOBSSUB,ITHK,IVOID,IMETHOD,ISTPCS,ALPHA IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading ISCRCB,ISCROC,NSYSTM,NOBSSUB,ITHK,IVOID,IMETHOD,ISTPCS,ALPHA',IOS,IU(ISCR)) RETURN ENDIF ALLOCATE(LNWT(NSYSTM)) READ(IU(ISCR),*,IOSTAT=IOS) LNWT IF(IOS.NE.0)THEN; CALL IMPORT_ERROR('Error reading LNWT(NSYSTM)',IOS,IU(ISCR)); RETURN; ENDIF DO I=1,NOBSSUB READ(IU(ISCR),*,IOSTAT=IOS) ICOL,IROW IF(IOS.NE.0)THEN; CALL IMPORT_ERROR('Error reading ICOL,IROW',IOS,IU(ISCR)); RETURN; ENDIF ENDDO READ(IU(ISCR),*,IOSTAT=IOS) IZCFL,IZCFM,IGLFL,IGLFM,IESTFL,IESTFM,IPCSFL,IPCSFM IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading IZCFL,IZCFM,IGLFL,IGLFM,IESTFL,IESTFM,IPCSFL,IPCSFM',IOS,IU(ISCR)) RETURN ENDIF LINE=TRIM(VTOS(NLAY))//',(scr)' WRITE(IURUN,'(A)') TRIM(LINE) !## geostatic stress IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'GEOSTATIC_STRESS[GL0]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\GEOSTATIC_STRESS[GL0].IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN LINE='1.0,0.0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) !## unsaturated specific gravity IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'UNSAT_SPECIFIC_GRAVITY[SGM]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\UNSAT_SPECIFIC_GRAVITY[SGM].IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN LINE='1.0,0.0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) !## saturated specific gravity IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'SAT_SPECIFIC_GRAVITY[SGS]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\SAT_SPECIFIC_GRAVITY[SGS].IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN LINE='1.0,0.0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) !## thickness IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'THICKNESS'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\THICKNESS_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN !## recompression index IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'RELOADING_RESWELLING_INDEX[RRISOA]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\RELOADING_RESWELLING_INDEX[RRISOA]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN !## compression index IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'COMPRESSION_INDEX[RRISOB]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\COMPRESSION_INDEX[RRISOB]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN !## secondary compression index IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'SECONDARY_COMPRESSION_INDEX[CAISOC]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\SECONDARY_COMPRESSION_INDEX[CAISOC]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN !## initial void ratio IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'INI_VOID_RATIO[VOID]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\INI_VOID_RATIO[VOID]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN !## initial compaction IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'INI_COMPACTION[SUB]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\INI_COMPACTION[SUB]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\THICKNESS_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\RELOADING_RESWELLING_INDEX[RRISOA]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\COMPRESSION_INDEX[RRISOB]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\SECONDARY_COMPRESSION_INDEX[CAISOC]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\INI_VOID_RATIO[VOID]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO DO ISYS=1,NSYSTM ILAY=LNWT(ISYS) LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\INI_COMPACTION[SUB]_ISYS'//TRIM(VTOS(ISYS))//'_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO !## initial preconsolidation stress DO ILAY=1,NLAY IF(ISTPCS.NE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'OFFSET_INI_EFFECTIVE_STRESS[PCSOFF]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\OFFSET_INI_EFFECTIVE_STRESS[PCSOFF]_L'//TRIM(VTOS(ILAY))//'.IDF' ELSEIF(ISTPCS.EQ.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(ISCR),IDF%X,IDF%NCOL,IDF%NROW,'INI_EFFECTIVE_STRESS[PCS]'))RETURN LINE=TRIM(DIR_DBS)//'\SWT\VERSION_1\INI_EFFECTIVE_STRESS[PCS]_L'//TRIM(VTOS(ILAY))//'.IDF' ENDIF CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE); WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IMPORT_SCR=.TRUE. END FUNCTION IMPORT_SCR !###==================================================================== LOGICAL FUNCTION IMPORT_HFB() !###==================================================================== IMPLICIT NONE INTEGER :: IR1,IR2,IC1,IC2,NHFB,JHFB,I,NPHFB,MXFB,NHFBNP INTEGER,ALLOCATABLE,DIMENSION(:) :: JU REAL(KIND=DP_KIND) :: F,XC,YC IMPORT_HFB=.FALSE. IF(IUNIT(IHFB).EQ.0)THEN IMPORT_HFB=.TRUE. RETURN ENDIF IF(IFUNIT(IHFB).EQ.0)RETURN LINE=TRIM(VTOS(NLAY))//',(hfb)' WRITE(IURUN,'(A)') TRIM(LINE) !## open files for writing ALLOCATE(JU(NLAY)) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\HOR_BARRIER_FLOW\VERSION_1\HFB_L'//TRIM(VTOS(ILAY))//'.GEN' I=INDEX(LINE,'\',.TRUE.)-1; CALL UTL_CREATEDIR(LINE(:I)) JU(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(JU(ILAY),FILE=LINE,STATUS='REPLACE',ACTION='WRITE') ENDDO IF(MVERSION.EQ.2005.OR.MVERSION.EQ.2000)THEN !## skip comments CALL IMPORT_SKIPCOMMENTS(IU(IHFB)) READ(IU(IHFB),*) NPHFB,MXFB,NHFBNP DO I=1,NHFBNP READ(IU(IHFB),*) ILAY,IR1,IC1,IR2,IC2,F WRITE(JU(ILAY),'(I10)') I !## vertical IF(IR1.EQ.IR2)THEN XC=XMIN+SUM(DELR(1:MIN(IC1,IC2))) YC=YMAX-SUM(DELC(1:MIN(IR1,IR2)-1)) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC YC=YMAX-SUM(DELC(1:MIN(IR1,IR2))) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC WRITE(JU(ILAY),'(A3)') 'END' ENDIF !## horizontal IF(IC1.EQ.IC2)THEN YC=YMAX-SUM(DELC(1:MIN(IR1,IR2))) XC=XMIN+SUM(DELR(1:MIN(IC1,IC2)-1)) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC XC=XMIN+SUM(DELR(1:MIN(IC1,IC2))) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC WRITE(JU(ILAY),'(A3)') 'END' ENDIF ENDDO ELSE READ(IU(IHFB),*) MAXHFB DO ILAY=1,NLAY READ(IU(IHFB),*) NHFB IF(NHFB.GT.0)THEN DO JHFB=1,NHFB WRITE(JU(ILAY),'(I10)') JHFB READ(IU(IHFB),*) IR1,IC1,IR2,IC2,F !## vertical IF(IR1.EQ.IR2)THEN XC=XMIN+SUM(DELR(1:MIN(IC1,IC2))) YC=YMAX-SUM(DELC(1:MIN(IR1,IR2)-1)) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC YC=YMAX-SUM(DELC(1:MIN(IR1,IR2))) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC WRITE(JU(ILAY),'(A3)') 'END' ENDIF !## horizontal IF(IC1.EQ.IC2)THEN YC=YMAX-SUM(DELC(1:MIN(IR1,IR2))) XC=XMIN+SUM(DELR(1:MIN(IC1,IC2)-1)) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC XC=XMIN+SUM(DELR(1:MIN(IC1,IC2))) WRITE(JU(ILAY),'(2(F15.5,1X))') XC,YC WRITE(JU(ILAY),'(A3)') 'END' ENDIF END DO ENDIF ENDDO ENDIF DO ILAY=1,NLAY; WRITE(JU(ILAY),'(A3)') 'END'; CLOSE(JU(ILAY)); ENDDO; DEALLOCATE(JU) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\HOR_BARRIER_FLOW\VERSION_1\HFB_L'//TRIM(VTOS(ILAY))//'.GEN' IF(ILAY.LT.10)LINE=' '//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) IF(ILAY.GE.10)LINE=' '//TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(A)') TRIM(LINE) ENDDO IMPORT_HFB=.TRUE. END FUNCTION IMPORT_HFB !###==================================================================== LOGICAL FUNCTION IMPORT_MOC() !###==================================================================== IMPLICIT NONE IF(IUNIT(IMOC).EQ.0)THEN IMPORT_MOC=.TRUE. ! LINE=' '//TRIM(VTOS(0))//',(moc)' ! WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IMPORT_MOC=.FALSE. READ(IU(IMOC),*,IOSTAT=IOS) !## Tholen v1, 250*210*40 READ(IU(IMOC),*,IOSTAT=IOS) !## header READ(IU(IMOC),*,IOSTAT=IOS) !## 1 40 1 210 1 250 READ(IU(IMOC),*,IOSTAT=IOS) !## 0 0 0.000864 READ(IU(IMOC),*,IOSTAT=IOS) !## 80000000 -4 READ(IU(IMOC),*,IOSTAT=IOS) !## -0.25 -0.25 0.25 READ(IU(IMOC),*,IOSTAT=IOS) !## -0.25 0.25 0.25 READ(IU(IMOC),*,IOSTAT=IOS) !## 0.25 -0.25 -0.25 READ(IU(IMOC),*,IOSTAT=IOS) !## 0.25 0.25 -0.25 READ(IU(IMOC),*,IOSTAT=IOS) !## 10 0.01D0 1 READ(IU(IMOC),*,IOSTAT=IOS) !## 0 0 0 0 0 0 0 READ(IU(IMOC),*,IOSTAT=IOS) !## -1 ! !## use boundary to correct data --- otherwise troubles in scaling ! ALLOCATE(BAS(NLAY)) ! DO ILAY=1,NLAY ! LINE=TRIM(DIR_DBS)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(VTOS(ILAY))//'.IDF' ! LEX=IMPORT_READ_IDF(BAS(ILAY),LINE) ! ENDDO DO ILAY=1,NLAY IF(.NOT.IMPORT_READU2DREL(IU(IMOC),IDF%X,IDF%NCOL,IDF%NROW,'CONCENTRATION'))RETURN CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\CONCENTRATION\VERSION_1\CONCENTRATION_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO LINE=TRIM(VTOS(NLAY))//',(con)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\CONCENTRATION\VERSION_1\CONCENTRATION_L'//TRIM(VTOS(ILAY))//'.IDF' LINE=TRIM(VTOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(A)') TRIM(LINE) ENDDO IMPORT_MOC=.TRUE. END FUNCTION IMPORT_MOC !###==================================================================== LOGICAL FUNCTION IMPORT_WEL(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE INTEGER :: I,NWEL,IUF,NCOLP,ICOL,IROW,ILAY,IUIPF,IUTXT,N REAL(KIND=DP_KIND) :: Q,X,Y TYPE WELOBJ REAL(KIND=DP_KIND),POINTER,DIMENSION(:) :: Q END TYPE WELOBJ TYPE(WELOBJ),DIMENSION(:,:,:),ALLOCATABLE,SAVE :: WEL IMPORT_WEL=.FALSE. IF(IUNIT(IWEL).EQ.0)THEN; IMPORT_WEL=.TRUE.; RETURN; ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(IWEL).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(IWEL)) READ(IU(IWEL),'(A)') LINE IF(LINE(1:9).EQ.'PARAMETER')READ(IU(IWEL),'(A)') LINE IF(.NOT.FREEFORMATTED)READ(LINE,'(I10)',IOSTAT=IOS) MXWELL IF(FREEFORMATTED)READ(LINE,*,IOSTAT=IOS) MXWELL IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading MXWELL',IOS,IU(IWEL)) RETURN ENDIF !## allocate memory wells IF(IITYPE.EQ.2)THEN ALLOCATE(WEL(IDF%NCOL,IDF%NROW,NLAY)) DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL; DO ILAY=1,NLAY; WEL(ICOL,IROW,ILAY)%Q=>NULL(); ENDDO; ENDDO; ENDDO ENDIF ENDIF IUF=IU(IWEL) IF(.NOT.IMPORT_GETNUMBER(IUF,NWEL,MVERSION))RETURN IF(NWEL.LT.0)THEN IMPORT_WEL=.TRUE. IF(IITYPE.EQ.1)THEN LINE=' '//TRIM(VTOS(-1))//',(wel)' WRITE(IURUN,'(A)') TRIM(LINE) ENDIF RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NWEL))RETURN NCOLP=1 IF(IUNIT(IMOC).EQ.1)NCOLP=NCOLP+1 IF(.NOT.IMPORT_READPACKAGE(IUF,NWEL,NCOLP,'WEL',MVERSION,(/FL**3.0/FT/)))RETURN IF(IITYPE.EQ.1)THEN LINE=TRIM(DIR_DBS)//'\WEL\VERSION_1\WEL_'//TRIM(TSTAMP(IPER))//'_L' IF(.NOT.IMPORT_WRT1IPF(LINE,NWEL,IDF%XMIN,IDF%YMAX,NLAY,IDF%NROW,IDF%NCOL,DELR,DELC,IURUN))RETURN ELSE DO I=1,NWEL ICOL=XP(I)%ICOL IROW=XP(I)%IROW ILAY=XP(I)%ILAY Q =XP(I)%X(1) IF(.NOT.ASSOCIATED(WEL(ICOL,IROW,ILAY)%Q))THEN ALLOCATE(WEL(ICOL,IROW,ILAY)%Q(NPER)); WEL(ICOL,IROW,ILAY)%Q=0.0D0 ENDIF WEL(ICOL,IROW,ILAY)%Q(IPER)=WEL(ICOL,IROW,ILAY)%Q(IPER)+Q ENDDO ENDIF CALL IMPORT_DEALLOCATE_XP() IF(ABS(IUF).NE.IU(IWEL))CLOSE(ABS(IUF)) !## save wel in txt files IF(IPER.EQ.NPER.AND.IITYPE.EQ.2)THEN DO ILAY=1,NLAY N=0; DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(ASSOCIATED(WEL(ICOL,IROW,ILAY)%Q))N=N+1 ENDDO; ENDDO LINE=TRIM(DIR_DBS)//'\WEL\VERSION_1\WEL_L'//TRIM(VTOS(ILAY))//'.IPF' IUIPF=UTL_GETUNIT(); CALL OSD_OPEN(IUIPF,FILE=LINE,STATUS='REPLACE',ACTION='WRITE') WRITE(IUIPF,'(A)') TRIM(VTOS(N)) WRITE(IUIPF,'(A)') '3' WRITE(IUIPF,'(A)') 'X' WRITE(IUIPF,'(A)') 'Y' WRITE(IUIPF,'(A)') 'ID' WRITE(IUIPF,'(A)') '3,TXT' CALL UTL_CREATEDIR(TRIM(DIR_DBS)//'\WEL\VERSION_1\QTXT_'//TRIM(VTOS(ILAY))) DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(ASSOCIATED(WEL(ICOL,IROW,ILAY)%Q))THEN CALL IDFGETLOC(IDF,IROW,ICOL,X,Y) WRITE(IUIPF,'(A)') TRIM(VTOS(X,'F',2))//','//TRIM(VTOS(Y,'F',2))//',QTXT_'//TRIM(VTOS(ILAY))//'\Q_'// & TRIM(VTOS(ICOL))//'_'//TRIM(VTOS(IROW))//'_'//TRIM(VTOS(ILAY)) LINE=TRIM(DIR_DBS)//'\WEL\VERSION_1\QTXT_'//TRIM(VTOS(ILAY))//'\Q_'//TRIM(VTOS(ICOL))//'_'//TRIM(VTOS(IROW))//'_'//TRIM(VTOS(ILAY))//'.TXT' IUTXT=UTL_GETUNIT(); CALL OSD_OPEN(IUTXT,FILE=LINE,STATUS='REPLACE',ACTION='WRITE') WRITE(IUTXT,'(A)') TRIM(VTOS(NPER)) WRITE(IUTXT,'(A)') '2,1' WRITE(IUTXT,'(A)') 'DATE,-999.0' WRITE(IUTXT,'(A)') 'Q,-999.0' DO I=1,NPER WRITE(IUTXT,'(A)') TRIM(TSTAMP(I))//','//TRIM(VTOS(WEL(ICOL,IROW,ILAY)%Q(I),'F',3)) ENDDO CLOSE(IUTXT) ENDIF ENDDO; ENDDO CLOSE(IUIPF) ENDDO LINE=TRIM(VTOS(1))//',(WEL),1'; WRITE(IURUN,'(/A)') TRIM(LINE) WRITE(IURUN,'(A)') TSTAMP(1)(1:4)//'-'//TSTAMP(1)(5:6)//'-'//TSTAMP(1)(7:8)//' 00:00:00' WRITE(IURUN,'(A)') '001,'//TRIM(VTOS(NLAY)) DO I=1,NLAY LINE='1,2,'//TRIM(VTOS(I))//',1.0,0.0,-999.0,"'//TRIM(DIR_DBS)//'\WEL\VERSION_1\WEL_L'//TRIM(VTOS(I))//'.IPF"' WRITE(IURUN,'(A)') TRIM(LINE) ENDDO ENDIF IMPORT_WEL=.TRUE. END FUNCTION IMPORT_WEL !###==================================================================== LOGICAL FUNCTION IMPORT_DRN() !###==================================================================== IMPLICIT NONE INTEGER :: NDRN,IUF,NCOLP IMPORT_DRN=.FALSE. IF(IUNIT(IDRN).EQ.0)THEN IMPORT_DRN=.TRUE. RETURN ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(IDRN).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(IDRN)) READ(IU(IDRN),'(A)') LINE IF(LINE(1:9).EQ.'PARAMETER')READ(IU(IDRN),'(A)') LINE IF(.NOT.FREEFORMATTED)READ(LINE,'(I10)',IOSTAT=IOS) MXDRAIN IF(FREEFORMATTED)READ(LINE,*,IOSTAT=IOS) MXDRAIN IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading MXDRAIN',IOS,IU(IDRN)) RETURN ENDIF ENDIF IUF=IU(IDRN) IF(.NOT.IMPORT_GETNUMBER(IUF,NDRN,MVERSION))RETURN IF(NDRN.LT.0)THEN IMPORT_DRN=.TRUE. LINE=' '//TRIM(VTOS(-1))//',(drn)' WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NDRN))RETURN NCOLP=2 IF(IUNIT(IMOC).EQ.1)NCOLP=NCOLP+1 IF(.NOT.IMPORT_READPACKAGE(IUF,NDRN,NCOLP,'DRN',MVERSION,(/FL,FL**2.0D0/FT,1.0D0/)))RETURN LINE=TRIM(DIR_DBS)//'\DRN\VERSION_1\DRAIN' IF(.NOT.IMPORT_WRT1PACKAGE(LINE,IDF,NDRN,NCOLP,NLAY,'drn',(/'ELEVATION ','CONDUCTANCE ','CONCENTRATION'/), & (/-999.99D0,0.0D0,0.0D0/),IURUN,(/2,1,3/)))RETURN IF(ABS(IUF).NE.IU(IDRN))CLOSE(ABS(IUF)) CALL IMPORT_DEALLOCATE_XP() IMPORT_DRN=.TRUE. END FUNCTION IMPORT_DRN !###==================================================================== LOGICAL FUNCTION IMPORT_RIV() !###==================================================================== IMPLICIT NONE INTEGER :: NRIV,IUF,NCOLP IMPORT_RIV=.FALSE. IF(IUNIT(IRIV).EQ.0)THEN IMPORT_RIV=.TRUE. RETURN ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(IRIV).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(IRIV)) READ(IU(IRIV),'(A)') LINE IF(LINE(1:9).EQ.'PARAMETER')READ(IU(IRIV),'(A)') LINE IF(.NOT.FREEFORMATTED)READ(LINE,'(I10)',IOSTAT=IOS) MXRIVER IF(FREEFORMATTED)READ(LINE,*,IOSTAT=IOS) MXRIVER IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading MXRIVER',IOS,IU(IRIV)) RETURN ENDIF ENDIF IUF=IU(IRIV) IF(.NOT.IMPORT_GETNUMBER(IUF,NRIV,MVERSION))RETURN IF(NRIV.LT.0)THEN IMPORT_RIV=.TRUE. LINE=' '//TRIM(VTOS(-1))//',(riv)' WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NRIV))RETURN NCOLP=3+IRIV5 IF(IUNIT(IMOC).EQ.1)NCOLP=NCOLP+1 IF(.NOT.IMPORT_READPACKAGE(IUF,NRIV,NCOLP,'RIV',MVERSION,(/FL,FL**2.0D0/FT,FL,1.0D0,1.0D0/)))RETURN LINE=TRIM(DIR_DBS)//'\RIV\VERSION_1\RIV' IF(IUNIT(IMOC).EQ.0)THEN IF(.NOT.IMPORT_WRT1PACKAGE(LINE,IDF,NRIV,NCOLP,NLAY,'riv',(/'STAGE ','CONDUCTANCE ','BOTTOM ', & 'INFFACTOR ','CONCENTRATION'/), & (/-999.99D0,0.0D0,-999.99D0,0.0D0,0.0D0/),IURUN,(/2,1,3,4,5/)))RETURN ELSE IF(.NOT.IMPORT_WRT1PACKAGE(LINE,IDF,NRIV,NCOLP,NLAY,'riv',(/'STAGE ','CONDUCTANCE ','BOTTOM ', & 'CONCENTRATION','INFFACTOR '/), & (/-999.99D0,0.0D0,-999.99D0,0.0D0,0.0D0/),IURUN,(/2,1,3,4,5/)))RETURN ENDIF CALL IMPORT_DEALLOCATE_XP() IF(ABS(IUF).NE.IU(IRIV))CLOSE(ABS(IUF)) IMPORT_RIV=.TRUE. END FUNCTION IMPORT_RIV !###==================================================================== LOGICAL FUNCTION IMPORT_SFR() !###==================================================================== IMPLICIT NONE INTEGER :: I,II,J,JJ,JJJ,KK,JSG,N REAL(KIND=DP_KIND) :: X1,Y1,X2,Y2,QFLW,QROF,ETSW,PTSW,ROUGH,DEPTH,WIDTH INTEGER :: ICLC,DWNS,UPSG,IPRI,IPER TYPE SFROBJ INTEGER :: IROW,ICOL,ILAY,ISG END TYPE SFROBJ TYPE(SFROBJ),DIMENSION(:),ALLOCATABLE :: STR IMPORT_SFR=.FALSE. IF(IUNIT(ISTR).EQ.0)THEN; IMPORT_SFR=.TRUE.; RETURN; ENDIF IF(IFUNIT(ISTR).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(ISTR)) READ(IU(ISTR),'(A)') LINE IF(LINE(1:9).EQ.'PARAMETER')READ(IU(ISTR),'(A)') LINE IF(.NOT.FREEFORMATTED)READ(LINE,'(I10)',IOSTAT=IOS) MXSTREAM,NISG !,NTRIB,NDIV,ICALC,CONST,ISTCB1,ISTCB2,ICKSUR !,MXSTRNM IF(FREEFORMATTED)READ(LINE,*,IOSTAT=IOS) MXSTREAM,NISG !,NTRIB,NDIV,ICALC,CONST,ISTCB1,ISTCB2,ICKSUR !,MXSTRNM IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading MXSTREAM,NSS,NTRIB,NDIV,ICALC,CONST,ISTCB1,ISTCB2,ICKSUR,MXSTRNM',IOS,IU(ISTR)) RETURN ENDIF ! MXSTRNM=0 ! !## read stream-names ! DO I=1,MXSTRNM; READ(IU(ISTR),*) ; ENDDO ! IUF=IU(ISTR) LINE='1,(SFR),1'; WRITE(IURUN,'(/A)') TRIM(LINE) WRITE(IURUN,'(A)') TSTAMP(1)(1:4)//'-'//TSTAMP(1)(5:6)//'-'//TSTAMP(1)(7:8)//' 00:00:00' WRITE(IURUN,'(A)') '001,001' LINE=TRIM(DIR_DBS)//'\SFR\VERSION_1\SFR.ISG' WRITE(IURUN,'(A)') '1,2,001,1.0,0.0,-999.99,"'//TRIM(LINE)//'"' CALL UTL_CREATEDIR(TRIM(DIR_DBS)//'\SFR\VERSION_1') !## number of isg ALLOCATE(ISG(NISG)) DO I=1,NISG ISG(I)%SNAME='SEGMENT_'//TRIM(VTOS(I)) ISG(I)%ICLC=0; ISG(I)%NCLC=0; ISG(I)%ICLC=ISG(MAX(I-1,1))%ICLC+ISG(I)%NCLC !## two calc. nodes ISG(I)%ICRS=0; ISG(I)%NCRS=0; ISG(I)%ICRS=ISG(MAX(I-1,1))%ICRS+ISG(I)%NCRS !## single cross-section ISG(I)%ISTW=0; ISG(I)%NSTW=0; ISG(I)%ISTW=ISG(MAX(I-1,1))%ISTW+ISG(I)%NSTW !## single cross-section ISG(I)%IQHR=0; ISG(I)%NQHR=0; ISG(I)%IQHR=ISG(MAX(I-1,1))%IQHR+ISG(I)%NQHR !## single cross-section ISG(I)%NSEG=0; ISG(I)%ISEG=0 ENDDO ALLOCATE(STR(MXSTREAM)) DO I=1,MXSTREAM READ(IU(ISTR),*) STR(I)%ILAY,STR(I)%IROW,STR(I)%ICOL,STR(I)%ISG ENDDO !## determine number of coordinates ISFR=1; N=MXSTREAM+NISG; ALLOCATE(ISP(N)) ALLOCATE(ISD(NISG*2)) ALLOCATE(DATISD(NISG*2*NPER)) ALLOCATE(ISC(NISG)) ALLOCATE(DATISC(NISG*4)) !1 1 2 0 4961.17421687 9089.807868 0.0 0.0 0.024 !10.0 1.0 216.834 6.1237 !10.0 1.0 156.95 8.74751 !## number of isp J=0; I=0; N=0; DO !I=1,MXSTREAM I=I+1 IF(I.GT.MXSTREAM)EXIT N=N+1 J=J+1 !## start points IF(N.EQ.1)THEN CALL IDFGETLOC(IDF,STR(I)%IROW,STR(I)%ICOL,X2,Y2) ELSE IF(STR(I)%ISG.EQ.STR(I-1)%ISG.AND.I.NE.MXSTREAM)THEN !## intermediate points CALL IDFGETLOC(IDF,STR(I-1)%IROW,STR(I-1)%ICOL,X1,Y1) CALL IDFGETLOC(IDF,STR(I )%IROW,STR(I )%ICOL,X2,Y2) X2=(X1+X2)/2.0D0 Y2=(Y1+Y2)/2.0D0 ELSE !## end point CALL IDFGETLOC(IDF,STR(I-1)%IROW,STR(I-1)%ICOL,X2,Y2) JSG=STR(I-1)%ISG ISG(JSG)%ISEG=MAX(1,ISG(MAX(JSG-1,1))%ISEG+ISG(MAX(JSG-1,1))%NSEG) ISG(JSG)%NSEG=N N=0; I=I-1 ENDIF ENDIF ISP(J)%X=X2 ISP(J)%Y=Y2 ENDDO !## fill the rest per stress-period - two calculation nodes per stream and a single cross-section JJ=0; KK=0 DO I=1,NISG ISG(I)%ICLC=MAX(ISG(MAX(I-1,1))%ICLC+ISG(MAX(I-1,1))%NCLC,1); ISG(I)%NCLC=2 ISG(I)%ICRS=MAX(ISG(MAX(I-1,1))%ICRS+ISG(MAX(I-1,1))%NCRS,1); ISG(I)%NCRS=1 X1=0.0D0; DO II=ISG(I)%ISEG,ISG(I)%ISEG+ISG(I)%NSEG-2 X1=X1+UTL_DIST(ISP(II)%X,ISP(II)%Y,ISP(II+1)%X,ISP(II+1)%Y) ENDDO DO J=1,2 JJ=JJ+1 ISD(JJ)%IREF=MAX(ISD(MAX(JJ-1,1))%IREF+ISD(MAX(JJ-1,1))%N,1) ISD(JJ)%N=NPER IF(J.EQ.1)THEN ISD(JJ)%CNAME='FR_NODE' ISD(JJ)%DIST=0.0D0 ELSE ISD(JJ)%DIST=X1 ISD(JJ)%CNAME='TO_NODE' ENDIF ENDDO KK=KK+1 ISC(KK)%IREF=MAX(ISC(MAX(KK-1,1))%IREF+ISC(MAX(KK-1,1))%N,1) ISC(KK)%N=4 ISC(KK)%CNAME='CRS_SEGM_'//TRIM(VTOS(I)) ISC(KK)%DIST=X1/2.0D0 ENDDO !## read the time dependent section DO IPER=1,NPER READ(IU(ISTR),*) KK=0; JJJ=0; DO I=1,NISG DO J=1,2 JJJ=JJJ+1 JJ=(ISD(JJJ)%IREF+IPER)-1 IF(J.EQ.1)THEN READ(IU(ISTR),'(A)') LINE READ(LINE,*) JSG,ICLC,DWNS,UPSG IF(UPSG.GT.0)THEN READ(LINE,*) JSG,ICLC,DWNS,UPSG,IPRI,QFLW,QROF,ETSW,PTSW,ROUGH ELSE READ(LINE,*) JSG,ICLC,DWNS,UPSG,QFLW,QROF,ETSW,PTSW,ROUGH IPRI=0 ENDIF IF(JSG.NE.I)THEN WRITE(*,*) 'SOMETHING WENT WRONG' ENDIF ENDIF DATISD(JJ)%ICLC=ICLC+1 DATISD(JJ)%DWNS=DWNS DATISD(JJ)%UPSG=UPSG DATISD(JJ)%IPRI=IPRI+1 !## m3/s DATISD(JJ)%QFLW=QFLW/86400.0D0 DATISD(JJ)%QROF=QROF/86400.0D0 !## mm/d DATISD(JJ)%ETSW=ETSW *1000.0D0 DATISD(JJ)%PPTSW=PTSW*1000.0D0 IF(J.EQ.1)DATISD(JJ)%DWNS=0 IF(J.EQ.2)THEN DATISD(JJ)%UPSG=0 DATISD(JJ)%QFLW=0.0D0 ENDIF IF(DATISD(JJ)%ICLC.EQ.1)THEN READ(IU(ISTR),*) DATISD(JJ)%HCND,DATISD(JJ)%THCK,DATISD(JJ)%BTML,DATISD(JJ)%WIDTH,DEPTH ELSEIF(DATISD(JJ)%ICLC.EQ.2)THEN READ(IU(ISTR),*) DATISD(JJ)%HCND,DATISD(JJ)%THCK,DATISD(JJ)%BTML,DATISD(JJ)%WIDTH DEPTH=0.0D0 ELSE READ(IU(ISTR),*) DATISD(JJ)%HCND,DATISD(JJ)%THCK,DATISD(JJ)%BTML ENDIF DATISD(JJ)%WLVL=DATISD(JJ)%BTML+DEPTH READ(TSTAMP(IPER)(1:8),*) DATISD(JJ)%IDATE DATISD(JJ)%CTIME='00:00:00' ENDDO SELECT CASE (ICLC) CASE (1) !## create cross-section WIDTH=(DATISD(JJ-1)%WIDTH+DATISD(JJ)%WIDTH)/2.0D0 DEPTH=(DATISD(JJ-1)%WLVL-DATISD(JJ-1)%BTML)+ & (DATISD(JJ )%WLVL-DATISD(JJ )%BTML)/2.0D0 IF(DEPTH.EQ.0.0D0)DEPTH=1.0D0 KK=KK+1 DATISC(KK)%DISTANCE=-1.0D0*WIDTH/2.0D0 DATISC(KK)%BOTTOM=DEPTH DATISC(KK)%MRC=ROUGH KK=KK+1 DATISC(KK)%DISTANCE=-1.0D0*WIDTH/2.0D0 DATISC(KK)%BOTTOM=0.0D0 DATISC(KK)%MRC=ROUGH KK=KK+1 DATISC(KK)%DISTANCE= 1.0D0*WIDTH/2.0D0 DATISC(KK)%BOTTOM=0.0D0 DATISC(KK)%MRC=ROUGH KK=KK+1 DATISC(KK)%DISTANCE= 1.0D0*WIDTH/2.0D0 DATISC(KK)%BOTTOM=DEPTH DATISC(KK)%MRC=ROUGH CASE (2) END SELECT ENDDO ENDDO LINE=TRIM(DIR_DBS)//'\SFR\VERSION_1\SFR.ISG' ISGDOUBLE=4; IF(ISGOPENFILES(LINE,'REPLACE'))CALL ISGSAVEIT() IMPORT_SFR=.TRUE. END FUNCTION IMPORT_SFR !###==================================================================== LOGICAL FUNCTION IMPORT_GHB() !###==================================================================== IMPLICIT NONE INTEGER :: NGHB,IUF,NCOLP IMPORT_GHB=.FALSE. IF(IUNIT(IGHB).EQ.0)THEN IMPORT_GHB=.TRUE. ! LINE=' '//TRIM(VTOS(0))//',(ghb)' ! WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(IGHB).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(IGHB)) READ(IU(IGHB),'(A)') LINE IF(LINE(1:9).EQ.'PARAMETER')READ(IU(IGHB),'(A)') LINE IF(FREEFORMATTED)READ(LINE,*,IOSTAT=IOS) MXGHB IF(.NOT.FREEFORMATTED)READ(LINE,'(I10)',IOSTAT=IOS) MXGHB IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading MXGHB',IOS,IU(IGHB)) RETURN ENDIF ENDIF IUF=IU(IGHB) IF(.NOT.IMPORT_GETNUMBER(IUF,NGHB,MVERSION))RETURN IF(NGHB.LT.0)THEN IMPORT_GHB=.TRUE. LINE=' '//TRIM(VTOS(-1))//',(ghb)' WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NGHB))RETURN NCOLP=2 IF(IUNIT(IMOC).EQ.1)NCOLP=NCOLP+1 IF(.NOT.IMPORT_READPACKAGE(IUF,NGHB,NCOLP,'GHB',MVERSION,(/FL,FL**2/FT,1.0D0/)))RETURN LINE=TRIM(DIR_DBS)//'\GHB\VERSION_1\GHB' IF(.NOT.IMPORT_WRT1PACKAGE(LINE,IDF,NGHB,NCOLP,NLAY,'ghb',(/'STAGE ','CONDUCTANCE ','CONCENTRATION'/), & (/-999.99D0,0.0D0,0.0D0/),IURUN,(/2,1,3/)))RETURN CALL IMPORT_DEALLOCATE_XP() IF(ABS(IUF).NE.IU(IGHB))CLOSE(ABS(IUF)) IMPORT_GHB=.TRUE. END FUNCTION IMPORT_GHB !###==================================================================== LOGICAL FUNCTION IMPORT_RCH(IITYPE) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IITYPE INTEGER :: INRECH,INIRCH,IROW,ICOL IMPORT_RCH=.FALSE. IF(IUNIT(IRCH).EQ.0)THEN; IMPORT_RCH=.TRUE.; RETURN; ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(IRCH).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(IRCH)) READ(IU(IRCH),'(A)') LINE IF(LINE(1:9).EQ.'PARAMETER')READ(IU(IRCH),'(A)') LINE IF(FREEFORMATTED)THEN READ(LINE,*,IOSTAT=IOS) NRCHOP ELSE READ(LINE,'(I10)',IOSTAT=IOS) NRCHOP ENDIF IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading NRCHOP',IOS,IU(IRCH)) RETURN ENDIF IF(NRCHOP.EQ.2)IOS=1 IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading NRCHOP=2, not supported by iMOD',IOS,IU(IRCH)) RETURN ENDIF ENDIF INIRCH=0 IF(FREEFORMATTED)THEN READ(IU(IRCH),*,IOSTAT=IOS) INRECH ELSE READ(IU(IRCH),'(I10)',IOSTAT=IOS) INRECH ENDIF IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading INRECH',IOS,IU(IRCH)) RETURN ENDIF IF(INRECH.LT.0)THEN IF(IITYPE.EQ.1)THEN LINE=' '//TRIM(VTOS(-1))//',(rch)'; WRITE(IURUN,'(A)') TRIM(LINE) ENDIF IMPORT_RCH=.TRUE.; RETURN ENDIF IDF%NODATA=-999.9D0 IF(.NOT.IMPORT_READU2DREL(IU(IRCH),IDF%X,IDF%NCOL,IDF%NROW,'RCH'))RETURN LINE=TRIM(DIR_DBS)//'\RCH\VERSION_1\RCH_'//TRIM(TSTAMP(IPER))//'_L1.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)THEN IDF%X(ICOL,IROW)=FL/FT*IDF%X(ICOL,IROW)*1000.0D0 ELSE IDF%X(ICOL,IROW)=0.0D0 ENDIF ENDDO; ENDDO IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(NRCHOP.EQ.2.AND.INIRCH.GT.0)THEN IF(.NOT.IMPORT_READU2DINT(IU(IRCH),IDF%X,IDF%NCOL,IDF%NROW,'RCH_ILAY'))RETURN LINE=TRIM(DIR_DBS)//'\RCH\VERSION_1\RCH_ILAY_'//TRIM(TSTAMP(IPER))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF IF(IITYPE.EQ.1)THEN LINE=' '//TRIM(VTOS(1))//',(rch)' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\RCH\VERSION_1\RCH_'//TRIM(TSTAMP(IPER))//'_L1.IDF' LINE=' '//TRIM(VTOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' ELSE IF(IPER.EQ.1)THEN LINE=TRIM(VTOS(NPER))//',(RCH),1'; WRITE(IURUN,'(/A)') TRIM(LINE) ENDIF WRITE(IURUN,'(A)') TSTAMP(IPER)(1:4)//'-'//TSTAMP(IPER)(5:6)//'-'//TSTAMP(IPER)(7:8)//' 00:00:00' WRITE(IURUN,'(A)') '001,001' LINE='1,2,1,1.0,0.0,-999.0,"'//TRIM(DIR_DBS)//'\RCH\VERSION_1\RCH_'//TRIM(TSTAMP(IPER))//'_L1.IDF"' ENDIF WRITE(IURUN,'(A)') TRIM(LINE) IMPORT_RCH=.TRUE. END FUNCTION IMPORT_RCH !###==================================================================== LOGICAL FUNCTION IMPORT_EVT() !###==================================================================== IMPLICIT NONE INTEGER :: INSURF,INEVTR,INEXDP,INIEVT,IROW,ICOL INTEGER,DIMENSION(4) :: IEVTPER IMPORT_EVT=.FALSE. IF(IUNIT(IEVT).EQ.0)THEN IMPORT_EVT=.TRUE. RETURN ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(IEVT).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(IEVT)) IF(.NOT.FREEFORMATTED)READ(IU(IEVT),'(I10)',IOSTAT=IOS) NEVTOP IF(FREEFORMATTED)READ(IU(IEVT),*,IOSTAT=IOS) NEVTOP IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading NEVTOP',IOS,IU(IEVT)) RETURN ENDIF IF(NEVTOP.NE.1)THEN IF(IOS.NE.0)THEN CALL IMPORT_ERROR('NEVTOP='//TRIM(VTOS(NEVTOP)),1,IU(IEVT)) RETURN ENDIF ENDIF IEVTPER=0 ENDIF IF(.NOT.FREEFORMATTED)READ(IU(IEVT),'(4I10)',IOSTAT=IOS) INSURF,INEVTR,INEXDP,INIEVT IF(FREEFORMATTED)READ(IU(IEVT),*,IOSTAT=IOS) INSURF,INEVTR,INEXDP,INIEVT IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading INSURF,INEVTR,INEXDP,INIEVT',IOS,IU(IEVT)) RETURN ENDIF IF(INSURF.GE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IEVT),IDF%X,IDF%NCOL,IDF%NROW,'EVT'))RETURN LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_SURFACE_'//TRIM(LONGDATE1)//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IEVTPER(1)=IEVTPER(1)+1 ENDIF IF(INEVTR.GE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IEVT),IDF%X,IDF%NCOL,IDF%NROW,'EVT'))RETURN LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_RATE_'//TRIM(LONGDATE1)//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL/FT*IDF%X(ICOL,IROW)*1000.0D0 ENDDO; ENDDO IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IEVTPER(2)=IEVTPER(2)+1 ENDIF IF(INEXDP.GE.0)THEN IF(.NOT.IMPORT_READU2DREL(IU(IEVT),IDF%X,IDF%NCOL,IDF%NROW,'EVT'))RETURN LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_DEPTH_'//TRIM(LONGDATE1)//'.IDF' DO IROW=1,IDF%NROW; DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).NE.IDF%NODATA)IDF%X(ICOL,IROW)=FL*IDF%X(ICOL,IROW) ENDDO; ENDDO IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IEVTPER(3)=IEVTPER(3)+1 ENDIF IF(INIEVT.GE.0.AND.NEVTOP.EQ.2)THEN IF(.NOT.IMPORT_READU2DREL(IU(IEVT),IDF%X,IDF%NCOL,IDF%NROW,'EVT'))RETURN LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_IEVT_'//TRIM(LONGDATE1)//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IEVTPER(4)=IEVTPER(4)+1 ENDIF IF(INSURF.GE.0.OR.INEVTR.GE.0.OR.INEXDP.GE.0)THEN LINE=' '//TRIM(VTOS(1))//',(evt)' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_RATE_'//TRIM(LONGDATE1)//'.IDF' LINE=' '//TRIM(VTOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_SURFACE_'//TRIM(LONGDATE1)//'.IDF' LINE=' '//TRIM(VTOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\EVT\VERSION_1\EVT_DEPTH_'//TRIM(LONGDATE1)//'.IDF' LINE=' '//TRIM(VTOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE=' '//TRIM(VTOS(-1))//',(evt)' WRITE(IURUN,'(A)') TRIM(LINE) ENDIF IMPORT_EVT=.TRUE. END FUNCTION IMPORT_EVT !###==================================================================== LOGICAL FUNCTION IMPORT_ISG() !###==================================================================== IMPLICIT NONE IMPORT_ISG=.TRUE. ! LINE=' '//TRIM(VTOS(0))//',(isg)' ! WRITE(IURUN,'(A)') TRIM(LINE) END FUNCTION IMPORT_ISG !###==================================================================== LOGICAL FUNCTION IMPORT_CHD() !###==================================================================== IMPLICIT NONE INTEGER :: NCHD,JSUMPCK IMPORT_CHD=.FALSE. IF(IUNIT(ICHD).EQ.0)THEN IMPORT_CHD=.TRUE. RETURN ENDIF IF(IPER.EQ.1)THEN IF(IFUNIT(ICHD).EQ.0)RETURN CALL IMPORT_SKIPCOMMENTS(IU(ICHD)) IF(.NOT.FREEFORMATTED)READ(IU(ICHD),'(I10)',IOSTAT=IOS) MXCHD IF(FREEFORMATTED)READ(IU(ICHD),*,IOSTAT=IOS) MXCHD IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading MXCHD',IOS,IU(ICHD)) RETURN ENDIF ENDIF IF(.NOT.FREEFORMATTED)READ(IU(ICHD),'(I10)',IOSTAT=IOS) NCHD IF(FREEFORMATTED)READ(IU(ICHD),*,IOSTAT=IOS) NCHD IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Error reading NCHD',IOS,IU(ICHD)) RETURN ENDIF IF(NCHD.LT.0)THEN IMPORT_CHD=.TRUE. LINE=' '//TRIM(VTOS(-1))//',(chd)' WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NCHD))RETURN IF(.NOT.IMPORT_READPACKAGE(IU(ICHD),NCHD,1,'CHD',MVERSION,(/FL/)))RETURN LINE=TRIM(DIR_DBS)//'\CHD\VERSION_1\CHD' JSUMPCK=ISUMPCK ISUMPCK=0 IF(.NOT.IMPORT_WRT1PACKAGE(LINE,IDF,NCHD,1,NLAY,'chd',(/'STAGE '/), & (/-999.99D0/),IURUN,(/1/)))RETURN ISUMPCK=JSUMPCK CALL IMPORT_DEALLOCATE_XP() IMPORT_CHD=.TRUE. END FUNCTION IMPORT_CHD !###==================================================================== LOGICAL FUNCTION IMPORT_OLF() !###==================================================================== IMPLICIT NONE IMPORT_OLF=.TRUE. END FUNCTION IMPORT_OLF !###==================================================================== LOGICAL FUNCTION IMPORT_PTH() !###==================================================================== IMPLICIT NONE IMPORT_PTH=.TRUE. IF(IFUNIT(IPTH).EQ.0)RETURN IMPORT_PTH=.FALSE. READ(IU(IPTH),*) READ(IU(IPTH),*) READ(IU(IPTH),*) READ(IU(IPTH),*) !## delx IF(.NOT.IMPORT_READU2DREL(IU(IPTH),IDF%X,IDF%NCOL,1,'DELX'))RETURN !## dely IF(.NOT.IMPORT_READU2DREL(IU(IPTH),IDF%X,IDF%NROW,1,'DELY'))RETURN DO ILAY=1,NLAY IF(.NOT.IMPORT_READU2DREL(IU(IPTH),IDF%X,IDF%NCOL,IDF%NROW,'TOP'))RETURN LINE=TRIM(DIR_DBS)//'\TOPBOTTOM\VERSION_1\TOP_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IPTH),IDF%X,IDF%NCOL,IDF%NROW,'BOTTOM'))RETURN LINE=TRIM(DIR_DBS)//'\TOPBOTTOM\VERSION_1\BOTOM_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO IMPORT_PTH=.TRUE. END FUNCTION IMPORT_PTH !###==================================================================== LOGICAL FUNCTION IMPORT_HDS() !###==================================================================== IMPLICIT NONE INTEGER(KIND=4) :: KSTP,ILAY,IOS,ICOL,IROW,NCOL,NROW INTEGER(KIND=4) :: KPER !,ILAY,IOS,ICOL,IROW,NCOL,NROW REAL(KIND=DP_KIND) :: PERTIM,TOTIM CHARACTER(LEN=16) :: DESC IMPORT_HDS=.TRUE. IF(IFUNIT(IHDS).EQ.0)RETURN IMPORT_HDS=.FALSE. DO READ(IU(IHDS),IOSTAT=IOS) KSTP,KPER,PERTIM,TOTIM,DESC,NCOL,NROW,ILAY IF(IOS.NE.0)EXIT READ(IU(IHDS),IOSTAT=IOS) ((IDF%X(ICOL,IROW),ICOL=1,NCOL),IROW=1,NROW) LINE=TRIM(DIR_DBS)//'\RESULTS\HEADS\HEADS_L'//TRIM(VTOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO IMPORT_HDS=.TRUE. END FUNCTION IMPORT_HDS !###==================================================================== SUBROUTINE IMPORT_BCF_VCONT2C() !###==================================================================== IMPLICIT NONE INTEGER :: IROW,ICOL DO IROW=1,IDF%NROW DO ICOL=1,IDF%NCOL IF(IDF%X(ICOL,IROW).GT.0.0D0)THEN IDF%X(ICOL,IROW)=1.0D0/IDF%X(ICOL,IROW) ELSE IDF%X(ICOL,IROW)=1.0E6 ENDIF END DO END DO END SUBROUTINE IMPORT_BCF_VCONT2C !###==================================================================== LOGICAL FUNCTION IMPORT_OPENFILE(I) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: I INTEGER :: IOS IU(I)=0 IF(LEN_TRIM(FNAME(I)).EQ.0)THEN IMPORT_OPENFILE=.FALSE. RETURN ENDIF INQUIRE(FILE=TRIM(FNAME(I)),EXIST=IMPORT_OPENFILE) IF(.NOT.IMPORT_OPENFILE)THEN WRITE(*,'(A)') 'File '//TRIM(FNAME(I))//' does not exists' RETURN ENDIF IU(I)=UTL_GETUNIT() IF(I.EQ.26)THEN CALL OSD_OPEN(IU(I),FILE=TRIM(FNAME(I)),STATUS='OLD',ACTION='READ',FORM='UNFORMATTED',IOSTAT=IOS) ELSE CALL OSD_OPEN(IU(I),FILE=TRIM(FNAME(I)),STATUS='OLD',ACTION='READ',IOSTAT=IOS) ENDIF IMPORT_OPENFILE=.FALSE. IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Cannot OPEN file: '//TRIM(FNAME(I)),IOS,IU(I)) RETURN ENDIF IMPORT_OPENFILE=.TRUE. END FUNCTION IMPORT_OPENFILE !###==================================================================== LOGICAL FUNCTION IMPORT_INIT() !###==================================================================== IMPLICIT NONE INTEGER :: I IMPORT_INIT=.FALSE. CALL IMPORT_CLOSE() ALLOCATE(IU(0:MAXIUNIT),FNAME(0:MAXIUNIT),IUNIT(0:MAXIUNIT)) I=INDEX(RUNFILE,'\',.TRUE.) CALL UTL_CREATEDIR(RUNFILE(:I-1)) IURUN=UTL_GETUNIT() CALL OSD_OPEN(IURUN,FILE=RUNFILE,STATUS='REPLACE',ACTION='WRITE',IOSTAT=I) IF(I.NE.0)THEN CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'iMOD cannot open file:'//CHAR(13)//TRIM(RUNFILE),'Error') RETURN ENDIF CALL IMPORT_GETNAMES() IMPORT_INIT=.TRUE. END FUNCTION IMPORT_INIT !###==================================================================== SUBROUTINE IMPORT_CLOSE() !###==================================================================== IMPLICIT NONE IF(ALLOCATED(IU))DEALLOCATE(IU) IF(ALLOCATED(FNAME))DEALLOCATE(FNAME) IF(ALLOCATED(IUNIT))DEALLOCATE(IUNIT) IF(ALLOCATED(LAYCON))DEALLOCATE(LAYCON) IF(ALLOCATED(LAYCBD))DEALLOCATE(LAYCBD) IF(ALLOCATED(TRPY))DEALLOCATE(TRPY) IF(ALLOCATED(DELR))DEALLOCATE(DELR) IF(ALLOCATED(DELC))DEALLOCATE(DELC) IF(ALLOCATED(TPER))DEALLOCATE(TPER) IF(ALLOCATED(DTPER))DEALLOCATE(DTPER) IF(ALLOCATED(NSTP))DEALLOCATE(NSTP) IF(ALLOCATED(TSMULT))DEALLOCATE(TSMULT) IF(ALLOCATED(LAYTYPE))DEALLOCATE(LAYTYPE) IF(ALLOCATED(LAYAVG))DEALLOCATE(LAYAVG) IF(ALLOCATED(CHANI))DEALLOCATE(CHANI) IF(ALLOCATED(LAYVKA))DEALLOCATE(LAYVKA) IF(ALLOCATED(LAYWET))DEALLOCATE(LAYWET) CALL IDFDEALLOCATEX(IDF) END SUBROUTINE IMPORT_CLOSE END MODULE MOD_IMPORT_CALC