!! Copyright (C) Stichting Deltares, 2005-2019. !! !! 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,ITOS,RTOS,UTL_CAP,UTL_CREATEDIR,UTL_JDATETOIDATE,UTL_CLOSEUNITS,FTIMETOITIME USE MOD_IMPORT_PAR USE MOD_IMPORT_UTL USE MOD_IDF, ONLY : IDFALLOCATEX,IDFALLOCATESXY,IDFDEALLOCATEX,IDFREAD,IDFDEALLOCATE,IDFNULLIFY USE MOD_OSD, ONLY : OSD_OPEN CHARACTER(LEN=256),PRIVATE :: LINE INTEGER,PRIVATE :: NPER,ISS CONTAINS !###==================================================================== SUBROUTINE IMPORT_MF2005_MAIN(MFFNAME,OUTNAME) !###==================================================================== IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) :: MFFNAME,OUTNAME CHARACTER(LEN=3) :: EXT INTEGER :: IU,KU,IOS,I 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)) KU=UTL_GETUNIT() CALL OSD_OPEN(KU,FILE=OUTNAME,STATUS='UNKNOWN',ACTION='WRITE',IOSTAT=IOS) IF(IOS.NE.0)THEN; WRITE(*,'(/A)') 'iMOD cannot open file:'//TRIM(OUTNAME); STOP; 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) END SELECT END SUBROUTINE IMPORT_MF2005_MAIN !###==================================================================== SUBROUTINE IMPORT_MF2005_WEL(IU,KU) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IU,KU 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(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) !###==================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: IBATCH 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())RETURN IF(.NOT.IMPORT_BAS())RETURN IF(.NOT.IMPORT_DIS())RETURN 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())RETURN IF(IDF%IEQ.EQ.0)WRITE(IURUN,'(6(F10.2,1X))') IDF%XMIN,IDF%YMIN,IDF%XMAX,IDF%YMAX,IDF%DX,0.0D0 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)' ! ELSE; WRITE(IURUN,'(A)') '0,0 (sto)'; ENDIF 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)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(ITOS(1))//'.IDF' WRITE(IURUN,'(A)') '"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') 'MODULES FOR EACH LAYER' CALL IMPORT_READBASINRUNFILE() SELECT CASE (MVERSION) CASE (2000,2005) IF(.NOT.IMPORT_LPF().AND..NOT.IMPORT_BCF().AND..NOT.IMPORT_HUF())THEN !RETURN !.AND..NOT.IMPORT_HUF() ENDIF CASE DEFAULT IF(.NOT.IMPORT_BCF())RETURN END SELECT IF(.NOT.IMPORT_ANI())RETURN IF(.NOT.IMPORT_HFB())RETURN IF(.NOT.IMPORT_MOC())RETURN IF(.NOT.IMPORT_SCR())RETURN 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 WRITE(LONGDATE2,'(I8)') UTL_JDATETOIDATE(INT(TPER(0))) KPER=0; DO IPER=1,NPER TDT=0.0D0 DO I=1,NSTP(IPER) KPER=KPER+1 IF(NSTP(IPER).GT.1)THEN IF(I.EQ.1)THEN DT=DTPER(IPER)*(1.0D0-TSMULT(IPER))/(1.0D0-TSMULT(IPER)**NSTP(IPER)) ELSE DT=DT*TSMULT(IPER) ENDIF ELSE DT=DTPER(IPER) ENDIF TDT=TDT+DT 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(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))) LINE=TRIM(ITOS(KPER))//','//TRIM(RTOS(DT,'F',3))//','//TRIM(LONGDATE1)//','//TRIM(ITOS(1))//','//TRIM(LONGDATE2) 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) WRITE(LONGDATE2,'(I8,3I2.2)') UTL_JDATETOIDATE(INT(TT)),IH,IM,IS LINE=TRIM(ITOS(KPER))//','//TRIM(RTOS(DT,'G',7))//','//TRIM(LONGDATE1)//','//TRIM(ITOS(1))//','//TRIM(LONGDATE2) ENDIF ELSE LONGDATE1='STEADY-STATE' LINE=TRIM(ITOS(KPER))//',0.0D0,'//TRIM(LONGDATE1)//',1' 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(ITOS(IPER))//' date: '//TRIM(LONGDATE1)) !& 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(LONGDATE1) ENDIF WRITE(IURUN,'(A)') TRIM(LINE) IF(I.EQ.1)THEN IF(.NOT.IMPORT_WEL())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())RETURN IF(.NOT.IMPORT_OLF())RETURN IF(.NOT.IMPORT_CHD())RETURN IF(.NOT.IMPORT_ISG())RETURN IF(.NOT.IMPORT_STR())RETURN ELSE IF(IUNIT(IWEL).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(WEL)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IDRN).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(DRN)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IRIV).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(RIV)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IEVT).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(EVT)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IGHB).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(GHB)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(IRCH).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(RCH)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF ! IF(IUNIT(IOLF).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(OLF)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(ICHD).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(CHD)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF ! IF(IUNIT(IISG).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(ISG)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF IF(IUNIT(ISTR).EQ.0)THEN; LINE=' '//TRIM(ITOS(-1))//',(STR)'; WRITE(IURUN,'(A)') TRIM(LINE); ENDIF ENDIF ENDDO END DO !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(IPER.GT.NPER)THEN !## correct bas for chd package IF(.NOT.IMPORT_BAS_CHDCORRECTION())RETURN IF(.NOT.IMPORT_BCF_CORRECTION())RETURN 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) 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=10) :: 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','STR','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'.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'.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 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(*,*) 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) CALL OSD_OPEN(DATAI(I),FILE=DATAF(I),STATUS='OLD',ACTION='READ',IOSTAT=IOS) IF(IOS.NE.0)THEN CALL IMPORT_ERROR('Cannot open file: '//TRIM(DATAF(I)),IOS,DATAI(I)) RETURN ENDIF ENDDO END SUBROUTINE !###==================================================================== LOGICAL FUNCTION IMPORT_READCONFIG() !###==================================================================== IMPLICIT NONE 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 IDF%DX=MINCS; IDF%DY=MINCS !## 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 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() !###==================================================================== IMPLICIT NONE 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 WRITE(IURUN,'(2I10,3(E10.3,1X))') MAXITER,NITER,HCLOSE,RCLOSE,RELAX 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)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO ALLOCATE(BAS(NLAY)) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(ITOS(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,'STARTING HEADS'))RETURN LINE=TRIM(DIR_DBS)//'\STARTING_HEADS\VERSION_1\SHEAD_L'//TRIM(ITOS(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() !###==================================================================== IMPLICIT NONE LINE=TRIM(ITOS(NLAY))//',(bnd)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO LINE=TRIM(ITOS(NLAY))//',(shd)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\STARTING_HEADS\VERSION_1\SHEAD_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' 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)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(ITOS(ILAY))//'.IDF' LEX=IMPORT_READ_IDF(BAS(ILAY),LINE) ENDDO DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\CONSTANTHEAD\VERSION_1\CHD_STAGE_'//TRIM(LONGDATE1)//'_L'//TRIM(ITOS(ILAY))//'.IDF' ! TRIM(ITOS(UTL_JDATETOIDATE(TPER(0))))//'_L'//TRIM(ITOS(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)//'\IBOUND\VERSION_1\IBOUND_L'//TRIM(ITOS(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() !###==================================================================== IMPLICIT NONE INTEGER :: IROW,ICOL 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,'PRIMARY_STORAGE_COEFFICIENT'))RETURN CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\PRIMARY_STORAGE_COEFFICIENT\VERSION_1\SF1_L'//TRIM(ITOS(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,'TRANSMISSIVITY'))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)//'\TRANSMISSIVITY\VERSION_1\TRANSMISSIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN CASE (1,3) IF(.NOT.IMPORT_READU2DREL(IU(IBCF),IDF%X,IDF%NCOL,IDF%NROW,'PERMEABILITY'))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)//'\PERMEABILITY\VERSION_1\PERMEABILITY_L'//TRIM(ITOS(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)//'\GEOHYDROLOGY\VERSION_1\BOTTOM_L'//TRIM(ITOS(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,'VERTICAL_RESISTANCE'))RETURN LINE=TRIM(DIR_DBS)//'\VERTICAL_RESISTANCE\VERSION_1\VERTICAL_RESISTANCE_L'//TRIM(ITOS(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=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,'SECUNDARY_STORAGE_COEFFICIENT'))RETURN CALL IMPORT_CORRECT4IBOUND() LINE=TRIM(DIR_DBS)//'\SECUNDARY_STORAGE_COEFFICIENT\VERSION_1\SF2_L'//TRIM(ITOS(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)//'\GEOHYDROLOGY\VERSION_1\TOP_L'//TRIM(ITOS(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(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDDO LINE=TRIM(ITOS(NLAY))//',(kdw)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\TRANSMISSIVITY\VERSION_1\TRANSMISSIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO LINE=TRIM(ITOS(NLAY-1))//',(vcw)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY-1 LINE=TRIM(DIR_DBS)//'\VERTICAL_RESISTANCE\VERSION_1\VERTICAL_RESISTANCE_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(ISS.EQ.1)THEN LINE=TRIM(ITOS(NLAY))//',(sto)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\PRIMARY_STORAGE_COEFFICIENT\VERSION_1\SF1_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO ENDIF 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)//'\STARTING_HEADS\VERSION_1\SHEAD_L'//TRIM(ITOS(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)//'\PERMEABILITY\VERSION_1\PERMEABILITY_L'//TRIM(ITOS(ILAY))//'.IDF' LK(ILAY) =IMPORT_READ_IDF(K(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\VERTICAL_CONDUCTIVITY\VERSION_1\VERTICAL_CONDUCTIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' LVK(ILAY) =IMPORT_READ_IDF(VK(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\VERTICAL_ANISOTROPY\VERSION_1\VERTICAL_ANISOTROPY_L'//TRIM(ITOS(ILAY))//'.IDF' LVA(ILAY) =IMPORT_READ_IDF(VA(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\PRIMARY_SPECIFIC_STORAGE_COEFFICIENT\VERSION_1\PRIMARY_SPECIFIC_STORAGE_COEFFICIENT_L'// & TRIM(ITOS(ILAY))//'.IDF' LPSC(ILAY)=IMPORT_READ_IDF(PSC(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\GEOHYDROLOGY\VERSION_1\TOP_L'//TRIM(ITOS(ILAY))//'.IDF' LTOP(ILAY)=IMPORT_READ_IDF(TOP(ILAY),LINE) LINE=TRIM(DIR_DBS)//'\GEOHYDROLOGY\VERSION_1\BOTTOM_L'//TRIM(ITOS(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(ITOS(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(ITOS(ILAY))// & ' for comp. transmissivity! ','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)//'\TRANSMISSIVITY\VERSION_1\TRANSMISSIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,KD(ILAY)))RETURN ENDIF IF(LC(ILAY))THEN LINE=TRIM(DIR_DBS)//'\VERTICAL_RESISTANCE\VERSION_1\VERTICAL_RESISTANCE_L'//TRIM(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,C(ILAY)))RETURN ENDIF IF(LS(ILAY))THEN LINE=TRIM(DIR_DBS)//'\STORAGE_COEFFICIENT\VERSION_1\SF1_L'//TRIM(ITOS(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(ITOS(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(ITOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO LINE=TRIM(ITOS(NLAY))//',(ani)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\ANISOTROPY\VERSION_1\ANI_FACTOR_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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() !###==================================================================== IMPLICIT NONE 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 transmissivity !## 0=harmonic mean (This is most appropriate for confined and unconfined aquifers with abrupt boundaries in ! transmissivity 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,'PERMEABILITY'))THEN LINE=TRIM(DIR_DBS)//'\PERMEABILITY\VERSION_1\PERMEABILITY_L'//TRIM(ITOS(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,'ANISOTROPY'))RETURN LINE=TRIM(DIR_DBS)//'\ANISOTROPY\VERSION_1\ANI_FACTOR_L'//TRIM(ITOS(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,'VERTICAL_CONDUCTIVITY'))RETURN LINE=TRIM(DIR_DBS)//'\VERTICAL_CONDUCTIVITY\VERSION_1\VERTICAL_CONDUCTIVITY_L'//TRIM(ITOS(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,'VERTICAL_ANISOTROPY'))RETURN LINE=TRIM(DIR_DBS)//'\VERTICAL_ANISOTROPY\VERSION_1\VERTICAL_ANISOTROPY_L'//TRIM(ITOS(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,'PRIMARY_SPECIFIC_STORAGE_COEFFICIENT'))RETURN LINE=TRIM(DIR_DBS)//'\PRIMARY_SPECIFIC_STORAGE_COEFFICIENT\VERSION_1\PRIMARY_SPECIFIC_STORAGE_COEFFICIENT_L'// & TRIM(ITOS(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,'SECUNDARY_STORAGE_COEFFICIENT'))RETURN LINE=TRIM(DIR_DBS)//'\SECUNDARY_STORAGE_COEFFICIENT\VERSION_1\SECUNDARY_STORAGE_COEFFICIENT_L'// & TRIM(ITOS(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,'VERTICAL_CONDUCTIVITY'))RETURN LINE=TRIM(DIR_DBS)//'\VERTICAL_CONDUCTIVITY\VERSION_1\VERTICAL_CONDUCTIVITY_L'//TRIM(ITOS(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(ITOS(ILAY))//'.IDF' CALL IMPORT_CORRECT4IBOUND() IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDDO LINE=TRIM(ITOS(NLAY))//',(kdw)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\TRANSMISSIVITY\VERSION_1\TRANSMISSIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO LINE=TRIM(ITOS(NLAY-1))//',(vcw)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY-1 LINE=TRIM(DIR_DBS)//'\VERTICAL_RESISTANCE\VERSION_1\VERTICAL_RESISTANCE_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(ISS.EQ.1)THEN LINE=TRIM(ITOS(NLAY))//',(sto)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\STORAGE_COEFFICIENT\VERSION_1\SF1_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO ENDIF IMPORT_LPF=.TRUE. END FUNCTION IMPORT_LPF !###==================================================================== LOGICAL FUNCTION IMPORT_HUF() !###==================================================================== IMPLICIT NONE 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,'GEOHYDROLOGY'))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)//'\GEOHYDROLOGY\VERSION_1\TOP_HUF_L'//TRIM(ITOS(I))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'GEOHYDROLOGY'))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)//'\GEOHYDROLOGY\VERSION_1\THICKNESS_HUF_L'//TRIM(ITOS(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,'PERMEABILITY'))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)//'\PERMEABILITY\VERSION_1\PERMEABILITY_L'//TRIM(ITOS(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)//'\ANISOTROPY\VERSION_1\ANI_FACTOR_L'//TRIM(ITOS(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,'VERTICAL_CONDUCTIVITY'))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)//'\VERTICAL_CONDUCTIVITY\VERSION_1\VERTICAL_CONDUCTIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ELSE IF(.NOT.IMPORT_READU2DREL(IU(IHUF),IDF%X,IDF%NCOL,IDF%NROW,'VERTICAL_ANISOTROPY'))RETURN LINE=TRIM(DIR_DBS)//'\VERTICAL_ANISOTROPY\VERSION_1\VERTICAL_ANISOTROPY_L'//TRIM(ITOS(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,'PRIMARY_SPECIFIC_STORAGE_COEFFICIENT'))RETURN LINE=TRIM(DIR_DBS)//'\PRIMARY_SPECIFIC_STORAGE_COEFFICIENT\VERSION_1\PRIMARY_SPECIFIC_STORAGE_COEFFICIENT_L'// & TRIM(ITOS(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,'VERTICAL_CONDUCTIVITY'))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)//'\VERTICAL_CONDUCTIVITY\VERSION_1\VERTICAL_CONDUCTIVITY_L'//TRIM(ITOS(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,'GEOHYDROLOGY'))RETURN LINE=TRIM(DIR_DBS)//'\GEOHYDROLOGY\VERSION_1\WETDRY_L'//TRIM(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF ENDDO LINE=TRIM(ITOS(NLAY))//',(kdw)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\TRANSMISSIVITY\VERSION_1\TRANSMISSIVITY_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO LINE=TRIM(ITOS(NLAY-1))//',(vcw)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY-1 LINE=TRIM(DIR_DBS)//'\VERTICAL_RESISTANCE\VERSION_1\VERTICAL_RESISTANCE_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO IF(ISS.EQ.1)THEN LINE=TRIM(ITOS(NLAY))//',(sto)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\PRIMARY_STORAGE_COEFFICIENT\VERSION_1\SF1_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(2X,A)') TRIM(LINE) ENDDO ENDIF 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,'GEOHYDROLOGY'))RETURN LINE=TRIM(DIR_DBS)//'\GEOHYDROLOGY\VERSION_1\TOP_L'//TRIM(ITOS(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,'GEOHYDROLOGY'))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)//'\GEOHYDROLOGY\VERSION_1\BOTTOM_L'//TRIM(ITOS(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,'GEOHYDROLOGY'))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)//'\GEOHYDROLOGY\VERSION_1\BOTTOM_CONFBED_L'//TRIM(ITOS(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)//'\GEOHYDROLOGY\VERSION_1\TOP_L'//TRIM(ITOS(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(ITOS(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.0D0,0.0D0,'//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.0D0,0.0D0,'//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.0D0,0.0D0,'//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(ITOS(ISYS))//'_L'//TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(ISYS))//'_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(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(ITOS(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(ITOS(ILAY))//'.IDF' ENDIF CALL IMPORT_CORRECT4IBOUND(); IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN LINE=TRIM(ITOS(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(ITOS(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(ITOS(ILAY))//'.GEN' I=INDEX(LINE,'\',.TRUE.)-1; CALL UTL_CREATEDIR(LINE(:I)) JU(ILAY)=UTL_GETUNIT(); CALL OSD_OPEN(JU(ILAY),FILE=LINE,STATUS='UNKNOWN',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(ITOS(ILAY))//'.GEN' IF(ILAY.LT.10)LINE=' '//TRIM(ITOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) IF(ILAY.GE.10)LINE=' '//TRIM(ITOS(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(ITOS(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(ITOS(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(ITOS(ILAY))//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDDO LINE=TRIM(ITOS(NLAY))//',(con)' WRITE(IURUN,'(A)') TRIM(LINE) DO ILAY=1,NLAY LINE=TRIM(DIR_DBS)//'\CONCENTRATION\VERSION_1\CONCENTRATION_L'//TRIM(ITOS(ILAY))//'.IDF' LINE=TRIM(ITOS(ILAY))//',1.0D0,0.0D0,'//TRIM(LINE) WRITE(IURUN,'(A)') TRIM(LINE) ENDDO IMPORT_MOC=.TRUE. END FUNCTION IMPORT_MOC !###==================================================================== LOGICAL FUNCTION IMPORT_WEL() !###==================================================================== IMPLICIT NONE INTEGER :: NWEL,IUF,NCOLP 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 ENDIF IUF=IU(IWEL) IF(.NOT.IMPORT_GETNUMBER(IUF,NWEL,MVERSION))RETURN IF(NWEL.LT.0)THEN IMPORT_WEL=.TRUE. LINE=' '//TRIM(ITOS(-1))//',(wel)' WRITE(IURUN,'(A)') TRIM(LINE) 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,'WELL',MVERSION,(/FL**3.0/FT/)))RETURN LINE=TRIM(DIR_DBS)//'\WELLS\VERSION_1\WELLS_'//TRIM(LONGDATE1)//'_L' IF(.NOT.IMPORT_WRT1IPF(LINE,NWEL,IDF%XMIN,IDF%YMAX,NLAY,IDF%NROW,IDF%NCOL,DELR,DELC,IURUN))RETURN CALL IMPORT_DEALLOCATE_XP() IF(ABS(IUF).NE.IU(IWEL))CLOSE(ABS(IUF)) 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(ITOS(-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,'DRAIN',MVERSION,(/FL,FL**2.0D0/FT,1.0D0/)))RETURN LINE=TRIM(DIR_DBS)//'\DRAINS\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(ITOS(-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,'RIVER',MVERSION,(/FL,FL**2.0D0/FT,FL,1.0D0,1.0D0/)))RETURN LINE=TRIM(DIR_DBS)//'\RIVERS\VERSION_1\RIVER' 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_STR() !###==================================================================== IMPLICIT NONE INTEGER :: I,NSTR,IUF,NCOLP,NSS,NTRIB,NDIV,ICALC,CONST,ISTCB1,ISTCB2,ICKSUR,MXSTRNM IMPORT_STR=.FALSE. IF(IUNIT(ISTR).EQ.0)THEN IMPORT_STR=.TRUE. RETURN ENDIF IF(IPER.EQ.1)THEN 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,NSS,NTRIB,NDIV,ICALC,CONST,ISTCB1,ISTCB2,ICKSUR,MXSTRNM IF(FREEFORMATTED)READ(LINE,*,IOSTAT=IOS) MXSTREAM,NSS,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 !## read stream-names DO I=1,MXSTRNM; READ(IU(ISTR),*) ; ENDDO ENDIF IUF=IU(ISTR) IF(.NOT.IMPORT_GETNUMBER(IUF,NSTR,MVERSION))RETURN IF(NSTR.LT.0)THEN IMPORT_STR=.TRUE. LINE=' '//TRIM(ITOS(-1))//',(str)' WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NSTR))RETURN CALL IMPORT_SKIPCOMMENTS(IUF) NCOLP=10 IF(.NOT.IMPORT_READPACKAGE(IUF,NSTR,NCOLP,'STREAM',MVERSION,(/1.0D0,1.0D0,FL,FL,FL,FL,FL,FL**2/FT,FL**2.0D0/FT,FL**3.0/FT/)))RETURN LINE=TRIM(DIR_DBS)//'\STREAM\VERSION_1\STREAM' IF(.NOT.IMPORT_WRT1PACKAGE(LINE,IDF,NSTR,NCOLP,NLAY,'str',(/'SEGMENT ','REACH ','STAGE ', & 'BOTMIN ','BOTMAX ','LENGTH ', & 'WIDTH ', & 'LEAKINGIN ','LEAKINGOUT ','FLOW '/), & (/0.0D0,0.0D0,-999.99D0,-999.99D0,-999.99D0,0.0D0,0.0D0,0.0D0,0.0D0,0.0D0/),IURUN,(/1,2,3,4,5,6,7,8,9,10/)))RETURN CALL IMPORT_DEALLOCATE_XP() IF(ABS(IUF).NE.IU(ISTR))CLOSE(ABS(IUF)) IMPORT_STR=.TRUE. END FUNCTION IMPORT_STR !###==================================================================== LOGICAL FUNCTION IMPORT_GHB() !###==================================================================== IMPLICIT NONE INTEGER :: NGHB,IUF,NCOLP IMPORT_GHB=.FALSE. IF(IUNIT(IGHB).EQ.0)THEN IMPORT_GHB=.TRUE. ! LINE=' '//TRIM(ITOS(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(ITOS(-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,'GENERAL HEAD BOUNDARY',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() !###==================================================================== IMPLICIT NONE INTEGER :: INRECH,INIRCH,IROW,ICOL IMPORT_RCH=.FALSE. IF(IUNIT(IRCH).EQ.0)THEN IMPORT_RCH=.TRUE. ! LINE=' '//TRIM(ITOS(0))//',(rch)' ! WRITE(IURUN,'(A)') TRIM(LINE) 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 LINE=' '//TRIM(ITOS(-1))//',(rch)' WRITE(IURUN,'(A)') TRIM(LINE) IMPORT_RCH=.TRUE. RETURN ENDIF IF(.NOT.IMPORT_READU2DREL(IU(IRCH),IDF%X,IDF%NCOL,IDF%NROW,'RECHARGE'))RETURN LINE=TRIM(DIR_DBS)//'\RECHARGE\VERSION_1\RECHARGE_'//TRIM(LONGDATE1)//'_L1.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 IF(NRCHOP.EQ.2.AND.INIRCH.GT.0)THEN IF(.NOT.IMPORT_READU2DINT(IU(IRCH),IDF%X,IDF%NCOL,IDF%NROW,'RECHARGE_ILAY'))RETURN LINE=TRIM(DIR_DBS)//'\RECHARGE\VERSION_1\RECHARGE_ILAY_'//TRIM(LONGDATE1)//'.IDF' IF(.NOT.IMPORT_WRT1IDF(LINE,IDF))RETURN ENDIF LINE=' '//TRIM(ITOS(1))//',(rch)' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\RECHARGE\VERSION_1\RECHARGE_'//TRIM(LONGDATE1)//'_L1.IDF' LINE=' '//TRIM(ITOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' 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(ITOS(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,'EVAPOTRANSPIRATION'))RETURN LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\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,'EVAPOTRANSPIRATION'))RETURN LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\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,'EVAPOTRANSPIRATION'))RETURN LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\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,'EVAPOTRANSPIRATION'))RETURN LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\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(ITOS(1))//',(evt)' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\VERSION_1\EVT_RATE_'//TRIM(LONGDATE1)//'.IDF' LINE=' '//TRIM(ITOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\VERSION_1\EVT_SURFACE_'//TRIM(LONGDATE1)//'.IDF' LINE=' '//TRIM(ITOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') TRIM(LINE) LINE=TRIM(DIR_DBS)//'\EVAPOTRANSPIRATION\VERSION_1\EVT_DEPTH_'//TRIM(LONGDATE1)//'.IDF' LINE=' '//TRIM(ITOS(1))//',1.0D0,0.0D0,"'//TRIM(LINE)//'"' WRITE(IURUN,'(A)') TRIM(LINE) ELSE LINE=' '//TRIM(ITOS(-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(ITOS(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(ITOS(-1))//',(chd)' WRITE(IURUN,'(A)') TRIM(LINE) RETURN ENDIF IF(.NOT.IMPORT_ALLOCATE_XP(NCHD))RETURN IF(.NOT.IMPORT_READPACKAGE(IU(ICHD),NCHD,1,'CONSTANT_HEAD_BOUNDARY',MVERSION,(/FL/)))RETURN LINE=TRIM(DIR_DBS)//'\CONSTANTHEAD\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(ITOS(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(ITOS(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(ITOS(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' STOP 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='UNKNOWN',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