diff --git a/NBLM/NBLM_functions.for b/NBLM/NBLM_functions.for deleted file mode 100644 index 9e993be..0000000 --- a/NBLM/NBLM_functions.for +++ /dev/null @@ -1,451 +0,0 @@ -C ###################################################################### -C FUNCTIONS AND SUBROUTINES USED IN THE KAT2D PROGRAMMES -C -------------------------------------------------------------------- -C FUNCTION/SUB | USE -C -------------------------------------------------------------------- -C EXNER: CALCULATES THE EXNER FUNCTION GIVEN TH0 AND Z -C QSAT: DETERMINES SATURATION PRESSURE GIVEN TK AND EXNER -C MIDXZ: USED TO DETERMINE VALUES AT INTERMEDIATE GRID POINTS -C THOMAS_V: TRI-DIAGONAL INVERSION ROUTINE IN THE VERTICAL -C THOMAS_H: TRI-DIAGONAL INVERSION ROUTINE IN THE HORIZONTAL -C -------------------------------------------------------------------- -C ###################################################################### - FUNCTION DIRECTION(UD,VD) -C CALCULATES THE WIND DIRECTION - IMPLICIT NONE - REAL DIRECTION,UD,VD,PI - PI=180/3.14159 - DIRECTION=0. -C IF (UD.GT.0.AND.VD.GT.0) DIRECTION=0+ATAN(ABS(VD/UD))*PI -C IF (UD.LE.0.AND.VD.GT.0) DIRECTION=90+ATAN(ABS(UD/VD))*PI -C IF (UD.LE.0.AND.VD.LE.0) DIRECTION=180+ATAN(ABS(VD/UD))*PI -C IF (UD.GT.0.AND.VD.LE.0) DIRECTION=270+ATAN(ABS(UD/VD))*PI - IF (UD.GT.0.AND.VD.GE.0) DIRECTION=270-ATAN(ABS(VD/UD))*PI - IF (UD.LE.0.AND.VD.GT.0) DIRECTION=180-ATAN(ABS(UD/VD))*PI - IF (UD.LT.0.AND.VD.LE.0) DIRECTION=90-ATAN(ABS(VD/UD))*PI - IF (UD.GE.0.AND.VD.LT.0) DIRECTION=360-ATAN(ABS(UD/VD))*PI - END -C ###################################################################### - FUNCTION EXNER(Z_EX,TH0_EXZ,TH0_EXT,P_EXP) -C CALCULATES THE VALUE OF THE EXNER FUNCTION FOR A LINEAR -C POTENTIAL TEMPERATURE PROFILE GIVEN REFENCE HEIGHTS AND VALUES - IMPLICIT NONE - REAL EXNER,GRAV,CP,RD,P0,SIGMA,RV,LAMBDA,T0C,E0,EPS - PARAMETER (GRAV=9.8,CP=1005.,RD=287.,P0=1.E3,SIGMA=5.67E-8) - PARAMETER (RV=1.61*RD,LAMBDA=2.5E6,T0C=273.13,E0=6.11,EPS=0.622) - REAL Z_EX,TH0_EXZ,TH0_EXT,P_EXP - EXNER=-GRAV*(Z_EX-TH0_EXZ)/TH0_EXT+CP*(P_EXP/P0)**(RD/CP) - END -C ###################################################################### - FUNCTION QSAT(THEX,PEX) -C CALCULATES THE SATURATION VALUE FOR WATER VAPOUR GIVEN VALUES FOR -C THE LOCAL POTENTIAL TEMPERATURE AND EXNER FUNCTION - IMPLICIT NONE - REAL QSAT,GRAV,CP,RD,P0,SIGMA,RV,LAMBDA,T0C,E0,EPS - PARAMETER (GRAV=9.8,CP=1005.,RD=287.,P0=1.E3,SIGMA=5.67E-8) - PARAMETER (RV=1.61*RD,LAMBDA=2.5E6,T0C=273.13,E0=6.11,EPS=0.622) - REAL THEX,PEX,TDRY - TDRY=THEX*PEX/CP - QSAT=EPS*E0*EXP(LAMBDA/RV*(1/T0C-1/TDRY))/P0*(CP/PEX)**(CP/RD) - END -C ###################################################################### - - function vfilter_shape(zz,zzmax,zzmin) -c sets a sinusoidal shape, starting at 0 at the z=0 to 1 at z=zmax -c for use in relaxation and filtering (formally num_ksp) - implicit none - real zz,zzmax,zzmin - real vfilter_shape - - vfilter_shape=(1+sin((-.5+(zz-zzmin)/(zzmax-zzmin))*3.14159))/2. - - end function vfilter_shape - -C ###################################################################### - function roughwater(ustar) -c ustar=surface momentum flux - implicit none - real ustar - real re,limit,roughwater - real grav,alc,viscosity - parameter (grav=9.8,alc=0.016,viscosity=1.35e-5) -c - limit=abs(0.11*viscosity*grav/alc)**0.333 - if (ustar.le.limit) then - roughwater=0.11*viscosity/ustar - else - roughwater=alc/grav*ustar**2 - if (roughwater.gt.0.1) roughwater=0.1 !max roughness of 10cm - end if - end function roughwater -C ###################################################################### - function andreas(ustar,zra,pa,tka,stypeb) -c ustar=surface momentum flux -c zra=roughness length for momentum -c pa=surface pressure in hpa -c tka=surface temperature in kelvin - - use NBLM_constants - - implicit none - real ustar,zra,pa,tka - integer stypeb - real re,viscosity,andreas,ratio -c - viscosity=(1.35e-5+0.00937e-5*(tka-t0c))*1000./pa - re=ustar*zra/viscosity - if (stypeb.eq.ice.or.stypeb.eq.snow) then - ratio=0.317-0.565*log(re)-0.183*log(re)**2 - if (ratio.gt.0.317) ratio=0.317 - andreas=zra*exp(ratio) - end if - if (stypeb.eq.soil.or.stypeb.eq.grass.or.stypeb.eq.forest) then - ratio=-2. - andreas=zra*exp(ratio) - end if - if (stypeb.eq.water) then - ratio=-(2.5*re**.25-2.) - andreas=zra*exp(ratio) - end if - end function andreas -C ###################################################################### - FUNCTION SOLAR(LAT,LON,JULIAN_DAY,TIME_S,DIFUTC_H,Z_SURF - & ,N_CLOUD) -C DETERMINE SHORT WAVE FLUXES ON A HORIZONTAL SURFACE - IMPLICIT NONE - REAL*8 SOLAR - REAL*8 LAT,LON,JULIAN_DAY,TIME_S,DIFUTC_H,Z_SURF,N_CLOUD - REAL*8 HOURANG,EQTIME,SOLARTIME,DEC,DAY_BIG,DAY_END,AZ,AZT - REAL*8 DAYANG,TAU_A,TAU_C - REAL*8 SECPHOUR,SECPDAY,PI,S0 - PARAMETER (SECPHOUR=3600.,SECPDAY=86400.,PI=3.14159/180. - & ,S0=1367.) - - DAYANG=360./365.*(JULIAN_DAY-1.) - DEC=0.396-22.91*COS(PI*DAYANG)+4.025*SIN(PI*DAYANG) - EQTIME=(1.03+25.7*COS(PI*DAYANG)-440.*SIN(PI*DAYANG) - & -201.*COS(2.*PI*DAYANG)-562.*SIN(2.*PI*DAYANG))/SECPHOUR - SOLARTIME=MOD(TIME_S+SECPDAY+SECPHOUR*(LON/15.+DIFUTC_H+EQTIME) - & ,SECPDAY) - HOURANG=15.*(12.-SOLARTIME/SECPHOUR) -C SET AZIMUTH ANGLE FOR ATMOSPHERIC CORRECTIONS - AZT=SIN(PI*DEC)*SIN(PI*LAT)+COS(PI*DEC)*COS(PI*LAT) - & *COS(PI*HOURANG) - IF (ABS(AZT).LE.1.) THEN - AZ=ACOS(AZT)/PI - ELSE - AZ=0. - END IF -C CORRECTIONS FOR ATMOSPHERE AND CLOUD FROM OERLEMANS (GREENLAND) - TAU_A=(0.75+6.8E-5*Z_SURF-7.1E-9*Z_SURF**2)*(1-.001*AZ) -C TAU_C=1-0.41*N_CLOUD-0.37*N_CLOUD**2 - TAU_C=1-0.78*N_CLOUD**2*EXP(-8.5E-4*Z_SURF) -C SET DAY BEGINNING AND END - IF (ABS(TAN(PI*DEC)*TAN(PI*LAT)).LE.1.) THEN - DAY_BIG=(12.-ACOS(-TAN(PI*DEC)*TAN(PI*LAT))/PI/15.)*SECPHOUR - DAY_END=(12.+ACOS(-TAN(PI*DEC)*TAN(PI*LAT))/PI/15.)*SECPHOUR - ELSE - DAY_BIG=0. - DAY_END=24.*SECPHOUR - END IF -C DETERMINE SOLAR RADIATION AT SURFACE DURING DAY - IF ((SOLARTIME.GT.DAY_BIG).AND.(SOLARTIME.LT.DAY_END)) THEN - SOLAR=S0*TAU_A*TAU_C*COS(AZ*PI) - ELSE - SOLAR=0. - END IF - IF (SOLAR.LT.0) SOLAR=0. -c write(*,'(4F12.4)') -c & solartime/secphour,time_s/secphour,DIFUTC_H,eqtime - END -C ###################################################################### - FUNCTION SOLARNEW(LAT,LON,JULIAN_DAY,TIME_S,DIFUTC_H,Z_SURF - & ,N_CLOUD,TSC,QSC) -C DETERMINE SHORT WAVE FLUXES ON A HORIZONTAL SURFACE - IMPLICIT NONE - REAL*8 SOLARNEW - REAL*8 LAT,LON,JULIAN_DAY,TIME_S,DIFUTC_H,Z_SURF,N_CLOUD - REAL*8 HOURANG,EQTIME,SOLARTIME,DEC,DAY_BIG,DAY_END,AZ,AZT - REAL*8 DAYANG,TAU_A,TAU_C - REAL*8 SECPHOUR,SECPDAY,PI,S0 - REAL*8 PRESS,MR,MA,W,TAUR,U1,AH2O,U3,AO3,TAUL,TSC,QSC - PARAMETER (SECPHOUR=3600.,SECPDAY=86400.,PI=3.14159/180. - & ,S0=1367.) - - DAYANG=360./365.*(JULIAN_DAY-1.) - DEC=0.396-22.91*COS(PI*DAYANG)+4.025*SIN(PI*DAYANG) - EQTIME=(1.03+25.7*COS(PI*DAYANG)-440.*SIN(PI*DAYANG) - & -201.*COS(2.*PI*DAYANG)-562.*SIN(2.*PI*DAYANG))/SECPHOUR - SOLARTIME=MOD(TIME_S+SECPDAY+SECPHOUR*(LON/15.+DIFUTC_H+EQTIME) - & ,SECPDAY) - HOURANG=15.*(12.-SOLARTIME/SECPHOUR) -C SET AZIMUTH ANGLE FOR ATMOSPHERIC CORRECTIONS - AZT=SIN(PI*DEC)*SIN(PI*LAT)+COS(PI*DEC)*COS(PI*LAT) - & *COS(PI*HOURANG) - IF (ABS(AZT).LE.1.) THEN - AZ=ACOS(AZT)/PI - ELSE - AZ=0. - END IF -C CORRECTIONS FOR ATMOSPHERE AND CLOUD FROM OERLEMANS (GREENLAND) - TAU_A=(0.75+6.8E-5*Z_SURF-7.1E-9*Z_SURF**2)*(1-.001*AZ) - IF (COS(AZ*PI).GT.0) THEN - PRESS=1.E5*EXP(-.0001184*Z_SURF) - MR=((93.885-AZ)**1.253)/(COS(AZ*PI)+.15) - MA=MR*PRESS/1.E5 - W=0.493/TSC*QSC*PRESS/0.621 - TAUR=0.615958+0.375566*EXP(-.221185*MA) - U1=W*MA - AH2O=2.9*U1/((1.+141.5*U1)**.635+5.925*U1) - U3=.3*MR - AO3=.02118*U3/(1.+.042*U3+3.23E-4*U3**2) - & +1.082*U3/(1.+138.6*U3)**.805+.0658*U3/(1+(103.6*U3)**3) - TAUL=1+(AO3+AH2O)/(1-TAUR) - TAU_A=0.84*EXP(-.027*TAUL*MR) - WRITE (*,'(10E10.2)') TAU_A,TAUL,AO3,AH2O,TAUR,W,MR,AZ,QSC - ELSE - TAU_A=.75 - END IF - - TAU_C=1-0.78*N_CLOUD**2*EXP(-8.5E-4*Z_SURF) -C SET DAY BEGINNING AND END - IF (ABS(TAN(PI*DEC)*TAN(PI*LAT)).LE.1.) THEN - DAY_BIG=(12.-ACOS(-TAN(PI*DEC)*TAN(PI*LAT))/PI/15.)*SECPHOUR - DAY_END=(12.+ACOS(-TAN(PI*DEC)*TAN(PI*LAT))/PI/15.)*SECPHOUR - ELSE - DAY_BIG=0. - DAY_END=24.*SECPHOUR - END IF -C DETERMINE SOLAR RADIATION AT SURFACE DURING DAY - IF ((SOLARTIME.GT.DAY_BIG).AND.(SOLARTIME.LT.DAY_END)) THEN - SOLARNEW=S0*TAU_A*TAU_C*COS(AZ*PI) - ELSE - SOLARNEW=0. - END IF - IF (SOLARNEW.LT.0) SOLARNEW=0. - END -C ###################################################################### - FUNCTION DENSITY(Z_EX,TH0_EXZ,TH0_EXT,P_EXP,TK_DENS) - IMPLICIT NONE - REAL*8 DENSITY - REAL*8 Z_EX,TH0_EXZ,TH0_EXT,P_EXP,TK_DENS,PRESSURE - REAL*8 EXNER,GRAV,CP,RD,P0,SIGMA,RV,LAMBDA,T0C,E0,EPS - PARAMETER (GRAV=9.8,CP=1005.,RD=287.,P0=1.E3,SIGMA=5.67E-8) - PARAMETER (RV=1.61*RD,LAMBDA=2.5E6,T0C=273.13,E0=6.11,EPS=0.622) - - PRESSURE=P0*(EXNER(Z_EX,TH0_EXZ,TH0_EXT,P_EXP)/CP)**(CP/RD) - DENSITY=PRESSURE*100./(RD*TK_DENS) - END -C ###################################################################### - SUBROUTINE THOMAS_K(XX,A,B,C,E,LMIN,LMAX - & ,II1,JJ1,KK1,II2,JJ2,KK2,II,JJ) -C SOLVES A TRIDIAGONAL MATRIX (A,B,C) WITH SOURCE ARRAY (E) -C AND RETURNS THE SOLUTION TO XX -C THIS SOLVES FOR GRIDS IN THE VERTICAL DIRECTION -C ARRAYS MUST BE SPECIFIED FROM LMIN TO LMAX HAVING -C DIMENSIONS FROM KKD1 TO KKD2 POSITIONED AT II. -C -C B1..C1.. I E1 -C A2..B2..C2.. I E2 -C ..A3..B3..C3.. I E3 -C ..A4..B4..C4.. I E4 -C I . -C ..A?..B?..C?.. I E? -C I . -C ..AM..BM I EM -C - IMPLICIT NONE - INTEGER*4 II1,II2,JJ1,JJ2,KK1,KK2,II,JJ - INTEGER*4 L,LMIN,LMAX - REAL*8 XX(II1:II2,JJ1:JJ2,KK1:KK2) - REAL*8 A(KK1:KK2),B(KK1:KK2),C(KK1:KK2),E(KK1:KK2) -C - DO L=LMIN+1,LMAX - B(L)=B(L)-A(L)/B(L-1)*C(L-1) - E(L)=E(L)-A(L)/B(L-1)*E(L-1) - END DO - DO L=LMAX-1,LMIN,-1 - E(L)=E(L)-C(L)/B(L+1)*E(L+1) - END DO - DO L=LMIN,LMAX - XX(II,JJ,L)=E(L)/B(L) - END DO - END -C ###################################################################### - SUBROUTINE THOMAS_I(XX,A,B,C,E,LMIN,LMAX - & ,II1,JJ1,KK1,II2,JJ2,KK2,JJ,KK) -C SOLVES A TRIDIAGONAL MATRIX (A,B,C) WITH SOURCE ARRAY (E) -C AND RETURNS THE SOLUTION TO XX -C THIS SOLVES FOR GRIDS IN THE VERTICAL DIRECTION -C ARRAYS MUST BE SPECIFIED FROM LMIN TO LMAX HAVING -C DIMENSIONS FROM KKD1 TO KKD2 POSITIONED AT II. -C -C B1..C1.. I E1 -C A2..B2..C2.. I E2 -C ..A3..B3..C3.. I E3 -C ..A4..B4..C4.. I E4 -C I . -C ..A?..B?..C?.. I E? -C I . -C ..AM..BM I EM -C - IMPLICIT NONE - INTEGER*4 II1,II2,JJ1,JJ2,KK1,KK2,JJ,KK - INTEGER*4 L,LMIN,LMAX - REAL*8 XX(II1:II2,JJ1:JJ2,KK1:KK2) - REAL*8 A(II1:II2),B(II1:II2),C(II1:II2),E(II1:II2) -C - DO L=LMIN+1,LMAX - B(L)=B(L)-A(L)/B(L-1)*C(L-1) - E(L)=E(L)-A(L)/B(L-1)*E(L-1) - END DO - DO L=LMAX-1,LMIN,-1 - E(L)=E(L)-C(L)/B(L+1)*E(L+1) - END DO - DO L=LMIN,LMAX - XX(L,JJ,KK)=E(L)/B(L) - END DO - END -C ###################################################################### - SUBROUTINE THOMAS_J(XX,A,B,C,E,LMIN,LMAX - & ,II1,JJ1,KK1,II2,JJ2,KK2,II,KK) -C SOLVES A TRIDIAGONAL MATRIX (A,B,C) WITH SOURCE ARRAY (E) -C AND RETURNS THE SOLUTION TO XX -C THIS SOLVES FOR GRIDS IN THE VERTICAL DIRECTION -C ARRAYS MUST BE SPECIFIED FROM LMIN TO LMAX HAVING -C DIMENSIONS FROM KKD1 TO KKD2 POSITIONED AT II. -C -C B1..C1.. I E1 -C A2..B2..C2.. I E2 -C ..A3..B3..C3.. I E3 -C ..A4..B4..C4.. I E4 -C I . -C ..A?..B?..C?.. I E? -C I . -C ..AM..BM I EM -C - IMPLICIT NONE - INTEGER*4 II1,II2,JJ1,JJ2,KK1,KK2,II,KK - INTEGER*4 L,LMIN,LMAX - REAL*8 XX(II1:II2,JJ1:JJ2,KK1:KK2) - REAL*8 A(JJ1:JJ2),B(JJ1:JJ2),C(JJ1:JJ2),E(JJ1:JJ2) -C - DO L=LMIN+1,LMAX - B(L)=B(L)-A(L)/B(L-1)*C(L-1) - E(L)=E(L)-A(L)/B(L-1)*E(L-1) - END DO - DO L=LMAX-1,LMIN,-1 - E(L)=E(L)-C(L)/B(L+1)*E(L+1) - END DO - DO L=LMIN,LMAX - XX(II,L,KK)=E(L)/B(L) - END DO - END -C ###################################################################### - SUBROUTINE MATRIXS(AC,E,B,NF,LF) - IMPLICIT NONE - INTEGER NF,LM,LF,N,L,NB,NLIM - REAL E(1:NF),B(1:NF),AC(1:LF,1:NF),APIV,AMULT -C -C MATRIX SOLVER WITHOUT PIVOTING AND REDUCED ARRAY CONVERSION -C SOLVES A BAND MATRIX OF DEPTH N AND BAND WIDTH LM -C AC IS THE MATRIX TO BE SOLVED STORED IN REDUCED FORM -C E IS THE SOURCE VECTOR -C B IS THE SOLUTION VECTOR -C LF AND NF ARE THE MATRIX DIMENSIONS -C #################################################################### -C ORIGINAL ARRAY:[M,N] WITH BAND WIDTH=LM -C -------------------------------------------------------------------- -C A[1,1] A[2,1] . . A[LM,1] 0 . . . . 0 | E[1] -C A[1,2] A[2,2] A[1+LM,2] . | E[2] -C . . . | -C . . 0 | -C A[1,LM] A[M,N] . A[NF,NF-LM] | E[N] -C 0 A[2,1+LM]. . . | -C . . . . | -C . . . . | -C 0 . . . 0 A[NF-LM,NF] . . A[NF,NF] | E[NF] -C -C #################################################################### -C REDUCED ARRAY:[L,N] WITH ARRAY WIDTH=LF=2*LM-1 -C -------------------------------------------------------------------- -C 0 0 A[1,1] A[2,1] . . . A[LF,1] | E[1] -C 0 A[1,2] A[2,2] . . . . . A[LF,2] | E[2] -C A[1,3] A[2,3] . | E[3] -C A[2,4] . . . | -C . . . . | -C A[N-LM,N+LM-1] . . . A[L,N] . . A[LF,N] | E[N] -C . . . . | -C 0 | -C A[N-LM,NF] . . . . A[L,NF] . 0 0 | E[NF] -C -C #################################################################### -C - LM=(LF+1)/2 !SET THE BAND WIDTH DERIVED FROM LF -C -C SOLVE FOR LEFT SIDE------------------------------------------------ - DO NB=1,NF-1 -C NORMALISE AROUND PIVOT - APIV=AC(LM,NB) - if (apiv.ne.0.) then - DO L=1,LF - AC(L,NB)=AC(L,NB)/APIV - END DO - E(NB)=E(NB)/APIV - else - write(*,*) 'Pivot 0 in matrix solver ',nb - endif -C LOOP THROUGH AND SUBTRACT NB ROW FROM N ROW - NLIM=MIN(NB+LM-1,NF) - DO N=NB+1,NLIM - AMULT=AC(LM-N+NB,N) - IF (AMULT.NE.0.) THEN - DO L=1,LF-N+NB - AC(L,N)=AC(L,N)-AMULT*AC(L+N-NB,NB) - END DO - E(N)=E(N)-AMULT*E(NB) - END IF - END DO - END DO -C SOLVE FOR RIGHT SIDE----------------------------------------------- - DO NB=NF,2,-1 -C NORMALISE AROUND PIVOT - APIV=AC(LM,NB) - if (apiv.ne.0.) then - DO L=LF,LM,-1 - AC(L,NB)=AC(L,NB)/APIV - END DO - E(NB)=E(NB)/APIV - else - write(*,*) 'Pivot 0 in matrix solver ',nb - endif -C LOOP THROUGH AND SUBTRACT NB ROW FROM N ROW - NLIM=MAX(NB-LM+1,1) - DO N=NB-1,NLIM,-1 - AMULT=AC(LM-N+NB,N) - IF (AMULT.NE.0.) THEN - DO L=LF,LM,-1 - AC(L,N)=AC(L,N)-AMULT*AC(L+N-NB,NB) - END DO - E(N)=E(N)-AMULT*E(NB) - END IF - END DO - END DO -C NORMALISE AROUND LAST PIVOT - NB=1 - APIV=AC(LM,NB) - if (apiv.ne.0.) then - DO L=LF,LM,-1 - AC(L,NB)=AC(L,NB)/APIV - END DO - E(NB)=E(NB)/APIV - else - write(*,*) 'Pivot 0 in matrix solver ',nb - endif -C PUT THE DERIVED VECTOR E INTO B------------------------------------ - DO N=1,NF - B(N)=E(N) - END DO - END SUBROUTINE MATRIXS -C #################################################################### - diff --git a/NILU/incrtm.f90 b/NILU/incrtm.f90 index 20e62e5..ce0a69b 100644 --- a/NILU/incrtm.f90 +++ b/NILU/incrtm.f90 @@ -140,3 +140,134 @@ subroutine incrtm(hhchange,yyyy,mm,dd,hh) end subroutine incrtm + subroutine minute_increment(minute_change,yyyy,mm,dd,hh,minutes) + + implicit none + + ! *** This subroutine changes the INOUT time: yy mm dd hh by the integer value "minute_change". + + INTEGER, INTENT(in) :: minute_change + INTEGER, INTENT(inout) :: yyyy + INTEGER, INTENT(inout) :: mm + INTEGER, INTENT(inout) :: dd + INTEGER, INTENT(inout) :: hh + INTEGER, INTENT(inout) :: minutes + + + ! *** Local variables: + + INTEGER :: i + INTEGER :: nday(12) + + + ! *** Local function + + LOGICAL :: LEAP + + ! *** LEAP - If leap year then true else false + + + nday = (/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/) + + + if (minute_change > 0 ) then + + ! **** Increment "minute_change" hours forward in time: + + do i = 1, minute_change + + if ( LEAP(yyyy) ) nday(2) = 29 + + !Increment minutes: + + minutes = minutes + 1 + + if (minutes <= 59) cycle + + ! *** Increment one hour: + + hh = hh + 1 + minutes = 0 + + if (hh <= 23) cycle + + ! *** New day: + + dd = dd + 1 + + hh = 0 + + if (dd <= nday(mm)) cycle + + ! *** New month: + + mm = mm + 1 + + dd = 1 + + if (mm <= 12) cycle + + ! *** New year: + + yyyy = yyyy + 1 + + mm = 1 + + enddo ! do i = 1, minute_change + + elseif (minute_change < 0 ) then + + + + do i = 1, -minute_change + + if ( LEAP(yyyy) ) nday(2) = 29 + + ! *** Decrement one hour: + + hh = hh - 1 + + if (hh >= 0) cycle + + ! *** New day: + + dd = dd - 1 + + hh = 23 + + if (dd >= 0) cycle + + ! *** New month: + + mm = mm - 1 + + if (mm >=1 ) then + + else + + ! *** Last year: + + yyyy = yyyy - 1 + + mm = 12 + + endif + + dd = nday(mm) + + enddo ! do i = 1, minute_change + + endif + + + + return + + + +! *** End of subroutine minute_increment + + + + end subroutine minute_increment + diff --git a/NORTRIP/NORTRIP_reading_functions.f90 b/NORTRIP/NORTRIP_reading_functions.f90 deleted file mode 100644 index 21f52ab..0000000 --- a/NORTRIP/NORTRIP_reading_functions.f90 +++ /dev/null @@ -1,560 +0,0 @@ -!---------------------------------------------------------------------- -! Various functions for manipulating and reading text in tab format -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function match_string_char_2048(match_str,unit_in,unit_output,default_char) - !Finds a leading string and returns the string that follows it - !Tab delimitted before and after - implicit none - - character(2048) match_string_char_2048 - character (*) match_str,default_char - character(2048) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - temp_str1='' - temp_str2='Not available' - temp_str2=trim(default_char) - rewind(unit_in) - do while (index(temp_str1,match_str).eq.0) - read(unit_in,'(a)',end=10) temp_str - if (temp_str(1:1).eq.'#'.or.temp_str(1:1).eq.'!') goto 5 !If first character is ! or # then ignore and go to next - index_val=index(temp_str,achar(9)) - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - if (index_val.gt.0) then - temp_str2=temp_str(1:index_val-1) - else - temp_str2=temp_str - endif - -5 end do - - match_string_char_2048=trim(temp_str2) - - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,A)') trim(match_str),' = ',adjustl(trim(match_string_char_2048)) - endif - return - -10 write(unit_output,'(A)') 'WARNING: No match found to "'//trim(match_str)//'" in input files. Returning: '//trim(default_char) - match_string_char_2048=default_char - - end function match_string_char_2048 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function match_string_char(match_str,unit_in,unit_output,default_char) - !Finds a leading string and returns the string that follows it - !Tab delimitted before and after - implicit none - - character(256) match_string_char - character (*) match_str,default_char - character(256) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - temp_str1='' - temp_str2='Not available' - temp_str2=trim(default_char) - rewind(unit_in) - do while (index(temp_str1,match_str).eq.0) - read(unit_in,'(a)',end=10) temp_str - if (temp_str(1:1).eq.'#'.or.temp_str(1:1).eq.'!') goto 5 !If first character is ! or # then ignore and go to next - index_val=index(temp_str,achar(9)) - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - if (index_val.gt.0) then - temp_str2=temp_str(1:index_val-1) - else - temp_str2=temp_str - endif -5 end do - - match_string_char=trim(temp_str2) - - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,A)') trim(match_str),' = ',adjustl(trim(match_string_char)) - endif - return - -10 write(unit_output,'(A)') 'WARNING: No match found to "'//trim(match_str)//'" in input files. Returning: '//trim(default_char) - match_string_char=default_char - - end function match_string_char -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function match_string_val(match_str,unit_in,unit_output,default_val) - !Finds a leading string and returns the real variable that follows it - !Tab delimitted before and after - implicit none - - real match_string_val,default_val - character (*) match_str - character(256) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - match_string_val=default_val - temp_str1='' - temp_str2='Not available' - rewind(unit_in) - do while (index(temp_str1,match_str).eq.0) - read(unit_in,'(a)',end=10) temp_str - if (temp_str(1:1).eq.'#'.or.temp_str(1:1).eq.'!') goto 5 !If first character is ! or # then ignore and go to next - index_val=index(temp_str,achar(9)) - !write(*,*) index_val,temp_str - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - !write(*,*) index_val,temp_str - if (index_val.gt.0) then - temp_str2=temp_str(1:index_val-1) - else - temp_str2=temp_str - endif -5 end do - !write(*,*) index_val,temp_str2 - if (LEN(trim(temp_str2)).gt.0) then - read(temp_str2,*,err=15) match_string_val - else - goto 15 - endif - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,ES10.2)') trim(match_str),' = ',match_string_val - endif - return - -10 write(unit_output,'(A)') 'WARNING: No match found to "'//trim(match_str)//'" in input files. Returning default value.' - return -15 write(unit_output,'(A)') 'WARNING: No value found for "'//trim(match_str)//'" in input files. Setting to default' - - end function match_string_val -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function match_string_int(match_str,unit_in,unit_output,default_int) - !Finds a leading string and returns the integer variable that follows it - !Tab delimitted before and after - implicit none - - integer match_string_int,default_int - character (*) match_str - character(256) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - match_string_int=default_int - temp_str1='' - temp_str2='Not available' - rewind(unit_in) - do while (index(temp_str1,match_str).eq.0) - read(unit_in,'(a)',end=10) temp_str - if (temp_str(1:1).eq.'#'.or.temp_str(1:1).eq.'!') goto 5 !If first character is ! or # then ignore and go to next - index_val=index(temp_str,achar(9)) - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - if (index_val.gt.0) then - temp_str2=temp_str(1:index_val-1) - else - temp_str2=temp_str - endif -5 end do - - if (LEN(trim(temp_str2)).gt.0) then - read(temp_str2,*,err=15) match_string_int - else - goto 15 - endif - - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,I10)') trim(match_str),' = ',match_string_int - endif - return - -10 write(unit_output,'(A)') 'WARNING: No match found to "'//trim(match_str)//'" in input files. Setting to 0' - return -15 write(unit_output,'(A)') 'WARNING: No value found for "'//trim(match_str)//'" in input files. Setting to 0' - - end function match_string_int -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function read_string_val(unit_in,unit_output) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - integer n_val - real read_string_val - character(256) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - read_string_val=-999 - temp_str1='' - temp_str2='Not available' - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - if (index_val.gt.0) then - temp_str2=temp_str(1:index_val-1) - else - temp_str2=temp_str - endif - read(temp_str2,*) read_string_val - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,es10.2)') trim(temp_str1),' = ',read_string_val - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_string_val' - - end function read_string_val -!---------------------------------------------------------------------- - - -!---------------------------------------------------------------------- - subroutine string_split_tab(unit_in,unit_output,out_str) - !Reads the next string in unit_in and returns the string that follows the first tab - - implicit none - - integer unit_in,unit_output - integer index_val - character(256) temp_str - character(256) out_str(2) - - read(unit_in,'(a)',ERR=10) temp_str - index_val=index(temp_str,achar(9)) - out_str(1)=temp_str(1:index_val-1) - out_str(2)=temp_str(index_val+1:) - return -10 write(unit_output,*) 'ERROR: End of file read during string_split_tab' - - end subroutine string_split_tab - -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine read_line_int1(unit_in,unit_output,val1) - !Reads a leading string and returns the integer variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - integer val1 - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - !Only take the first value - index_val=index(val_str,achar(9)) - if (index_val.gt.0) then - val_str=val_str(1:index_val-1) - endif - read(val_str,*) val1 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,i10)') trim(header_str),' = ',val1 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_int1' - - end subroutine read_line_int1 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine read_line_int2(unit_in,unit_output,val1,val2) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - integer val1,val2 - - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - read(val_str,*) val1,val2 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,2i10)') trim(header_str),' = ',val1,val2 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_int2' - - end subroutine read_line_int2 -!---------------------------------------------------------------------- -!---------------------------------------------------------------------- - subroutine read_line_val1(unit_in,unit_output,val1) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - real val1 - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - !Only take the first value - index_val=index(val_str,achar(9)) - if (index_val.gt.0) then - val_str=val_str(1:index_val-1) - endif - read(val_str,*) val1 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,es10.2)') trim(header_str),' = ',val1 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_val1' - - end subroutine read_line_val1 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine read_line_val2(unit_in,unit_output,val1,val2) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - real val1,val2 - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - read(val_str,*) val1,val2 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,2es10.2)') trim(header_str),' = ',val1,val2 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_val2' - - end subroutine read_line_val2 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine read_line_val3(unit_in,unit_output,val1,val2,val3) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - real val1,val2,val3 - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - read(val_str,*) val1,val2,val3 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,3es10.2)') trim(header_str),' = ',val1,val2,val3 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_val3' - - end subroutine read_line_val3 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine read_line_val4(unit_in,unit_output,val1,val2,val3,val4) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - real val1,val2,val3,val4 - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - read(val_str,*) val1,val2,val3,val4 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,4es10.2)') trim(header_str),' = ',val1,val2,val3,val4 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_val4' - - end subroutine read_line_val4 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine read_line_val5(unit_in,unit_output,val1,val2,val3,val4,val5) - !Reads a leading string and returns the real variable that follows it - !Tab delimitted between. - implicit none - - character(256) header_str,val_str,temp_str - integer unit_in,unit_output - integer index_val - real val1,val2,val3,val4,val5 - - read(unit_in,'(a)',end=10) temp_str - index_val=index(temp_str,achar(9)) - header_str=temp_str(1:index_val-1) - val_str=temp_str(index_val+1:) - read(val_str,*) val1,val2,val3,val4,val5 - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,5es10.2)') trim(header_str),' = ',val1,val2,val3,val4,val5 - endif - return - -10 write(unit_output,*) 'ERROR: End of file read during read_line_val5' - - end subroutine read_line_val5 -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine match_string_multi_int(match_str,unit_in,unit_output,val,n_val) - !Finds a leading string and returns all the integer variables that follows it - !Tab delimitted before and free format after - implicit none - - integer n_val - integer val(n_val) - character (*) match_str - character(256) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - val=-999 - temp_str1='' - temp_str2='Not available' - rewind(unit_in) - do while (index(temp_str1,match_str).eq.0) - read(unit_in,'(a)',end=10) temp_str - if (temp_str(1:1).eq.'#'.or.temp_str(1:1).eq.'!') goto 5 !If first character is ! or # then ignore and go to next - index_val=index(temp_str,achar(9)) - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - !if (index_val.gt.0) then - ! temp_str2=temp_str(1:index_val-1) - !else - ! temp_str2=temp_str - !endif -5 end do - if (LEN(trim(temp_str)).gt.0) then - read(temp_str,*) val(1:n_val) - else - goto 15 - endif - - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,I10)') trim(match_str),' = ',val - endif - return - -10 write(unit_output,*) 'WARNING: No match found to "'//trim(match_str)//'" in input files. Set to -999' - return -15 write(unit_output,*) 'WARNING: No values for "'//trim(match_str)//'" in input files' - - end subroutine match_string_multi_int -!---------------------------------------------------------------------- - - !---------------------------------------------------------------------- - subroutine match_string_multi_val(match_str,unit_in,unit_output,val,n_val) - !Finds a leading string and returns all the integer variables that follows it - !Tab delimitted before and free format after - !Not used - implicit none - - integer n_val - real val(n_val) - character (*) match_str - character(256) temp_str1,temp_str2,temp_str - integer unit_in,unit_output - integer index_val - - val=-999. - temp_str1='' - temp_str2='Not available' - rewind(unit_in) - do while (index(temp_str1,match_str).eq.0) - read(unit_in,'(a)',end=10) temp_str - if (temp_str(1:1).eq.'#'.or.temp_str(1:1).eq.'!') goto 5 !If first character is ! or # then ignore and go to next - index_val=index(temp_str,achar(9)) - temp_str1=temp_str(1:index_val-1) - temp_str=temp_str(index_val+1:) - index_val=index(temp_str,achar(9)) - !if (index_val.gt.0) then - ! temp_str2=temp_str(1:index_val-1) - !else - ! temp_str2=temp_str - !endif -5 end do - if (LEN(trim(temp_str)).gt.0) then - read(temp_str,*) val(1:n_val) - else - goto 15 - endif - - if (unit_output.ge.0) then - write(unit_output,'(A40,A3,es10.2)') trim(match_str),' = ',val - endif - return - -10 write(unit_output,*) 'WARNING: No match found to "'//trim(match_str)//'" in input files. Set to -999' - return -15 write(unit_output,*) 'WARNING: No values for "'//trim(match_str)//'" in input files' - - end subroutine match_string_multi_val -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function replace_string_char(replace_str,match_str,read_str) - !Finds a leading string and returns the string that follows it - !Tab delimitted before and after - implicit none - - character(256) replace_string_char - character (*) match_str,replace_str,read_str - character(256) temp_str1,temp_str2 - integer index_start,index_stop - - replace_string_char=read_str - - index_start=index(read_str,trim(match_str)) - if (index_start.ne.0) then - index_stop=index_start+len(match_str) - temp_str1=read_str(1:index_start-1) - temp_str2=read_str(index_stop:len(read_str)) - replace_string_char=trim(temp_str1)//trim(replace_str)//trim(temp_str2) - endif - !write(*,'(A)') trim(replace_string_char) - - end function replace_string_char -!---------------------------------------------------------------------- diff --git a/NORTRIP/NORTRIP_time_functions.f90 b/NORTRIP/NORTRIP_time_functions.f90 deleted file mode 100644 index 414bc28..0000000 --- a/NORTRIP/NORTRIP_time_functions.f90 +++ /dev/null @@ -1,560 +0,0 @@ -!---------------------------------------------------------------------- -! Various functions for manipulating time -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine number_to_date(date_num,date_array) - - implicit none - - double precision date_num - integer ref_year - integer y,m,d,i - integer date_array(6) - double precision day_fraction - integer day_int - integer day_count,days_in_year - integer rest_seconds - integer daysinmonth(12) - data (daysinmonth(i),i=1,12) /31,28,31,30,31,30,31,31,30,31,30,31/ - - ref_year=1970 - !Set day fraction to the nearest second. Avoiding round off errors - day_int=idint(date_num) - day_fraction=(date_num-day_int) - - !Determine hours, minutes and seconds - date_array=0 - rest_seconds=int(day_fraction*24.*3600.+.5) !Rounded off - date_array(4)=int(rest_seconds/3600.) - date_array(5)=int((rest_seconds/60.-date_array(4)*60.)) - date_array(6)=int((rest_seconds-date_array(4)*3600.-date_array(5)*60.)) - - !Count up days keeping track of the year, month and day of month - - !Determine year - y=ref_year-1 - day_count=0 - do while (day_count.le.day_int) - y=y+1 - days_in_year=365 - if (((mod(y,4).eq.0).and.(mod(y,100).ne.0)).or.(mod(y,400).eq.0)) days_in_year=366 - day_count=day_count+days_in_year - enddo - date_array(1)=y - day_count=day_count-days_in_year - - !Determine month given the year - daysinmonth(2)=28 - if (((mod(date_array(1),4).eq.0).and.(mod(date_array(1),100).ne.0)).or.(mod(date_array(1),400).eq.0)) daysinmonth(2)=29 - m=0 - !day_count=0 - - do while (day_count.le.day_int) - m=m+1 - day_count=day_count+daysinmonth(m) - enddo - date_array(2)=m - day_count=day_count-daysinmonth(m) - - !Determine day - d=0 - do while (day_count.le.day_int) - d=d+1 - day_count=day_count+1 - enddo - date_array(3)=d - - end subroutine number_to_date -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function date_to_number(a) - - implicit none - - double precision date_to_number - integer ref_year - integer y,m,d,i - integer a(6) - - integer daysinmonth(12) - data (daysinmonth(i),i=1,12) /31,28,31,30,31,30,31,31,30,31,30,31/ - - ref_year=1970 - date_to_number=0. - daysinmonth(2)=28 - if (a(1).gt.ref_year) then - !Add up days in the year - do y=ref_year,a(1)-1 - if (((mod(y,4).eq.0).and.(mod(y,100).ne.0)).or.(mod(y,400).eq.0)) then - daysinmonth(2)=29 - else - daysinmonth(2)=28 - endif - do m=1,12 - date_to_number=date_to_number+sngl(daysinmonth(m)) - end do - end do - endif - !Add up days in the remaining months - if (((mod(a(1),4).eq.0).and.(mod(a(1),100).ne.0)).or.(mod(a(1),400).eq.0)) then - daysinmonth(2)=29 - else - daysinmonth(2)=28 - endif - if (a(2).gt.1) then - do m=1,a(2)-1 - date_to_number=date_to_number+sngl(daysinmonth(m)) - enddo - endif - - date_to_number=date_to_number+sngl(a(3))-1. - date_to_number=date_to_number+sngl(a(4))/24. !starts at 0 - date_to_number=date_to_number+sngl(a(5))/24./60. !starts at 0 - date_to_number=date_to_number+sngl(a(6))/24./60./60. !starts at 0 - !write(*,*) date_to_number - - end function date_to_number -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function date_to_julian(a) - - implicit none - - double precision date_to_number - real date_to_julian - integer a(6),b(6) - - b(1)=a(1) - b(2)=1 - b(3)=1 - b(4)=0 - b(5)=0 - b(6)=0 - - date_to_julian=date_to_number(a)-date_to_number(b)+1 - - end function date_to_julian -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine datestr_to_date(a_str,format_str,a) - - implicit none - - character(24) a_str,format_str - integer a(6) - integer pos - - !based on (yyyy.mm.dd HH:MM:SS) - - !extract year - pos=index(format_str,'yyyy') - if (pos.gt.0) then - read(a_str(pos:pos+3),*) a(1) - else - a(1)=0 - endif - pos=index(format_str,'mm') - if (pos.gt.0) then - read(a_str(pos:pos+1),*) a(2) - else - a(2)=0 - endif - pos=index(format_str,'dd') - if (pos.gt.0) then - read(a_str(pos:pos+1),*) a(3) - else - a(3)=0 - endif - pos=index(format_str,'HH') - if (pos.gt.0) then - read(a_str(pos:pos+1),*) a(4) - else - a(4)=0 - endif - pos=index(format_str,'MM') - if (pos.gt.0) then - read(a_str(pos:pos+1),*) a(5) - else - a(5)=0 - endif - pos=index(format_str,'SS') - if (pos.gt.0) then - read(a_str(pos:pos+1),*) a(6) - else - a(6)=0 - endif - - end subroutine datestr_to_date -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine date_to_datestr(a,format_str,a_str) - - implicit none - - character(*) a_str,format_str - integer a(6) - integer pos - - !based on (yyyy.mm.dd HH:MM:SS) - - a_str=format_str - - !To avoid just putting in date parts e.g. mm or dd that might occurr in a string then it is required that at least two of the date - !strings are present, i.e. yyyy, mm and dd or HH, MM and SS - - if ((index(format_str,'yyyy').gt.0.and.index(format_str,'mm').gt.0).or.(index(format_str,'yyyy').gt.0.and.index(format_str,'dd').gt.0).or.(index(format_str,'dd').gt.0.and.index(format_str,'mm').gt.0).or. & - (index(format_str,'HH').gt.0.and.index(format_str,'MM').gt.0).or.(index(format_str,'HH').gt.0.and.index(format_str,'SS').gt.0).or.(index(format_str,'MM').gt.0.and.index(format_str,'SS').gt.0)) then - !Do nothing but continue with routine as this is a valid format for date string substitution - else - !Leave the routine - return - endif - - - !Now it only accepts the two strings 'yyyymmdd' and 'yyyymmddHH' for replacement - - pos=index(format_str,'yyyymmddHH') - if (pos.gt.0) then - write(a_str(pos:pos+3),'(i4)') a(1) - if (a(2).gt.9) then - write(a_str(pos+4:pos+5),'(i2)') a(2) - else - write(a_str(pos+4:pos+5),'(a1,i1)') '0',a(2) - endif - if (a(3).gt.9) then - write(a_str(pos+6:pos+7),'(i2)') a(3) - else - write(a_str(pos+6:pos+7),'(a1,i1)') '0',a(3) - endif - if (a(4).gt.9) then - write(a_str(pos+8:pos+9),'(i2)') a(4) - else - write(a_str(pos+8:pos+9),'(a1,i1)') '0',a(4) - endif - return - else - !a_str(pos:pos+3)='0000' - endif - - pos=index(format_str,'yyyymmdd') - if (pos.gt.0) then - write(a_str(pos:pos+3),'(i4)') a(1) - if (a(2).gt.9) then - write(a_str(pos+4:pos+5),'(i2)') a(2) - else - write(a_str(pos+4:pos+5),'(a1,i1)') '0',a(2) - endif - if (a(3).gt.9) then - write(a_str(pos+6:pos+7),'(i2)') a(3) - else - write(a_str(pos+6:pos+7),'(a1,i1)') '0',a(3) - endif - return - else - !a_str(pos:pos+3)='0000' - endif - - pos=index(format_str,'yyyymm') - if (pos.gt.0) then - write(a_str(pos:pos+3),'(i4)') a(1) - if (a(2).gt.9) then - write(a_str(pos+4:pos+5),'(i2)') a(2) - else - write(a_str(pos+4:pos+5),'(a1,i1)') '0',a(2) - endif - return - else - !a_str(pos:pos+3)='0000' - endif - - !return - !Do not do the rest - - !extract year - pos=index(format_str,'yyyy') - if (pos.gt.0) then - write(a_str(pos:pos+3),'(i4)') a(1) - else - !a_str(pos:pos+3)='0000' - endif - - pos=index(format_str,'mm') - if (pos.gt.0) then - if (a(2).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(2) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(2) - endif - else - !a_str(pos:pos+1)='00' - endif - - pos=index(format_str,'dd') - if (pos.gt.0) then - if (a(3).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(3) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(3) - endif - else - !a_str(pos:pos+1)='00' - endif - - pos=index(format_str,'HH') - if (pos.gt.0) then - if (a(4).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(4) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(4) - endif - else - !a_str(pos:pos+1)='00' - endif - - pos=index(format_str,'MM') - if (pos.gt.0) then - if (a(5).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(5) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(5) - endif - else - ! !a_str(pos:pos+1)='00' - endif - - pos=index(format_str,'SS') - if (pos.gt.0) then - if (a(6).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(6) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(6) - endif - else - !a_str(pos:pos+1)='00' - endif - - end subroutine date_to_datestr -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - subroutine date_to_datestr_bracket(a,in_format_str,out_a_str) - - implicit none - - character(*), intent(out) :: out_a_str - character(*), intent(in) :: in_format_str - integer, intent(in) :: a(6) - character(256) format_str,a_str - integer pos - integer pos1,pos2 - - !based on (yyyy.mm.dd HH:MM:SS) - - !a_str=format_str - - !To avoid just putting in date parts e.g. mm or dd that might occurr in a string then it is required that at least two of the date - !strings are present, i.e. yyyy, mm and dd or HH, MM and SS - - !Only changes dates when they are inside '<.....>' - !Removes these once changed - pos1=index(in_format_str,'<') - pos2=index(in_format_str,'>') - - if (pos1.le.0.or.pos2.le.0.or.pos1+1.gt.pos2-1) then - out_a_str=in_format_str - return - endif - - !Reassign format_str to be just the text between <..> - format_str=in_format_str(pos1+1:pos2-1) - a_str=format_str - - !extract year - pos=index(format_str,'yyyy') - if (pos.gt.0) then - write(a_str(pos:pos+3),'(i4)') a(1) - endif - - pos=index(format_str,'mm') - if (pos.gt.0) then - if (a(2).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(2) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(2) - endif - endif - - pos=index(format_str,'dd') - if (pos.gt.0) then - if (a(3).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(3) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(3) - endif - endif - - pos=index(format_str,'HH') - if (pos.gt.0) then - if (a(4).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(4) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(4) - endif - endif - - pos=index(format_str,'MM') - if (pos.gt.0) then - if (a(5).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(5) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(5) - endif - endif - - pos=index(format_str,'SS') - if (pos.gt.0) then - if (a(6).gt.9) then - write(a_str(pos:pos+1),'(i2)') a(6) - else - write(a_str(pos:pos+1),'(a1,i1)') '0',a(6) - endif - endif - - !insert the a_str into out_a_str, removing the '<>' text - if (len_trim(in_format_str).gt.pos2) then - out_a_str=in_format_str(1:pos1-1)//trim(a_str)//in_format_str(pos2+1:) - else - out_a_str=in_format_str(1:pos1-1)//trim(a_str) - endif - - !write(*,*) trim(in_format_str),trim(out_a_str) - !stop - - end subroutine date_to_datestr_bracket -!---------------------------------------------------------------------- - -!---------------------------------------------------------------------- - function day_of_week (a) - !Adapted from EPISODE code - - implicit none - -!The subroutine calculates the day of week given current datetime, -!where DAYW = 1 corresponds to Monday and DAYW = 7 to Sunday. The -!algorithm is based on the tables in "Hvem Hva Hvor 1971" (p. 121) -!and is valid for all years from 1800 to infinity! - - !USE mod_time - -! Local variables - - INTEGER JM(12) - INTEGER IR - INTEGER JC - INTEGER NT - INTEGER JK - INTEGER J4 - INTEGER J100 - INTEGER J400 - LOGICAL LEAP - -! JM - Column number for each month -! IR - Row in HHH table for day of month -! JC - Column in HHH table for month -! NT - Number in HHH table for row IR and column JC -! JK - Column in HHH table for year -! J4 - Adjustment value for leap year -! J100 - Adjustment value for leap year -! J400 - Adjustment value for leap year -! LEAP - If leap year then true else false - - integer DAYM,MNTH,YEAR - integer day_of_week - integer a(6) - - DAYM=a(3) - MNTH=a(2) - YEAR=a(1) - -!Calculate leap year or not - LEAP = .FALSE. - IF (MOD(YEAR, 4) .EQ. 0 .AND. .NOT. (MOD(YEAR,100) .EQ. 0 .AND. MOD(YEAR,400) .NE. 0)) LEAP = .TRUE. - - ! Set data in table JM - - DATA JM/1,5,5,2,7,4,2,6,3,1,5,3/ - -! Calculate row number for day of month - - IR = MOD(DAYM - 1,7) + 1 - -! Calculate column number for month - - JC = JM(MNTH) - IF (LEAP .AND. (MNTH .EQ. 1 .OR. MNTH .EQ. 2)) JC = JC + 1 - -! Calculate "number" in HHH table with row IR and column JC - - NT = MOD(IR + 7 - JC,7) + 1 - -! Calculate column number for year (adjusting for leap years) - - J4 = (YEAR - 1800)/4 - J100 = (YEAR - 1800)/100 - J400 = (YEAR - 1600)/400 - - JK = MOD(YEAR - 1800 + J4 - J100 + J400 + 3 - 1,7) + 1 - -! Calculate day of week - - day_of_week = MOD(JK - 1 + NT - 1,7) + 1 - - RETURN - -! End of subroutine CDAYW - - end function day_of_week -!---------------------------------------------------------------------- -!---------------------------------------------------------------------- - function summer_time_europe(a) - - implicit none - - logical summer_time_europe - integer a(6) - integer b_start(6),b_end(6) - integer ref_year - integer year - double precision datenum_start,datenum_end,datenum - double precision date_to_number - - a(2)=2 - ref_year=2000 - b_start=0 - b_end=0 - year=a(1) - b_start(1)=a(1) - b_start(2)=3 - b_start(3)=(31 - mod((((5 * year)/4) + 4),7)) - b_start(4)=1 - b_end(1)=a(1) - b_end(2)=10 - b_end(3)=(31 - mod((((5 * year)/4) + 1),7)) - b_end(4)=1 - - datenum_start=date_to_number(b_start) - datenum_end=date_to_number(b_end) - datenum=date_to_number(a) - - summer_time_europe=.false. - if (datenum.ge.datenum_start.and.datenum.lt.datenum_end) summer_time_europe=.true. - - !write(*,*) b_start(3),b_end(3),summer_time_europe - - end function summer_time_europe -!---------------------------------------------------------------------- \ No newline at end of file diff --git a/NORTRIP_multiroad_control_64bit.f90 b/NORTRIP_multiroad_control_64bit.f90 index 2e3d43c..5ae74da 100644 --- a/NORTRIP_multiroad_control_64bit.f90 +++ b/NORTRIP_multiroad_control_64bit.f90 @@ -90,7 +90,7 @@ subroutine NORTRIP_multiroad_control_64bit !Read in static road link data. if (index(calculation_type,'road weather').gt.0.or.index(calculation_type,'uEMEP').gt.0.or.index(calculation_type,'Avinor').gt.0) then call NORTRIP_multiroad_read_staticroadlink_data_ascii - elseif (index(calculation_type,'gridded')) then + elseif (index(calculation_type,'gridded')) then !TODO: Rewrite this to be a logical call NORTRIP_multiroad_read_staticroadlink_data_gridded else call NORTRIP_multiroad_read_staticroadlink_data @@ -121,12 +121,10 @@ subroutine NORTRIP_multiroad_control_64bit call NORTRIP_multiroad_read_activity_data - !Reorder the links and traffic data to fit the selection. Don't do it for the road weather option + !Reorder the links and traffic data to fit the selection. !It also sets the gridding flags so needs to be called - !if (index(calculation_type,'road weather').eq.0) then - call NORTRIP_multiroad_reorder_staticroadlink_data - !endif - + call NORTRIP_multiroad_reorder_staticroadlink_data + !Read DEM input data and make skyview file call process_terrain_data_64bit @@ -149,9 +147,11 @@ subroutine NORTRIP_multiroad_control_64bit !Read in meteo data from MEPs or METCOOP data. This is standard call NORTRIP_read_metcoop_netcdf4 if (replace_meteo_with_yr.eq.1) then - !call NORTRIP_read_t2m500yr_netcdf4 call NORTRIP_read_analysismeteo_netcdf4 endif + if (replace_meteo_with_met_forecast.eq.1) then + call NORTRIP_read_MET_Nordic_forecast_netcdf4 + endif elseif (index(meteo_data_type,'nora3').gt.0) then !Read in meteo data from MEPs or METCOOP data. This is standard call NORTRIP_read_nora3_netcdf4 @@ -165,9 +165,6 @@ subroutine NORTRIP_multiroad_control_64bit if (replace_meteo_with_yr.eq.1) then call NORTRIP_read_analysismeteo_netcdf4 endif - elseif (index(meteo_data_type,'nbv').gt.0) then - !Reads in meteo from special files made for Episode. Old and not used any more - call NORTRIP_read_meteo_NBV_netcdf4 else write(unit_logfile,'(2A)') 'No valid meteo_data_type provided: ',trim(meteo_data_type) write(unit_logfile,'(A)') 'Stopping ' @@ -175,7 +172,11 @@ subroutine NORTRIP_multiroad_control_64bit endif !Read and replace meteo model data with meteo obs data - call NORTRIP_multiroad_read_meteo_obs_data + if ( read_obs_from_netcdf ) then + call NORTRIP_multiroad_read_meteo_obs_data_netcdf + else + call NORTRIP_multiroad_read_meteo_obs_data + end if !Set the number of road links to be save !n_roadlinks=10 diff --git a/NORTRIP_multiroad_definitions.f90 b/NORTRIP_multiroad_definitions.f90 index 2cdade1..8854d49 100644 --- a/NORTRIP_multiroad_definitions.f90 +++ b/NORTRIP_multiroad_definitions.f90 @@ -52,7 +52,7 @@ module NORTRIP_multiroad_index_definitions !dimension netcdf fields integer x_index,y_index,time_index parameter (x_index=1,y_index=2,time_index=3) - + !-------------------------------------------------------for MET Nordic analysis----------------------------------------------------------------- !General variables. integer num_dims_nc2 parameter (num_dims_nc2=3) ! number of dimensions is 3 for all 2d fields used @@ -82,6 +82,40 @@ module NORTRIP_multiroad_index_definitions !dimension netcdf fields integer x_index2,y_index2,time_index2 parameter (x_index2=1,y_index2=2,time_index2=3) + !---------------------------------------------------------------------------------------------------------------------------------------------- + + !------------------------------------------for MET_Nordic forecast----------------------------------------------------------------------------- + integer num_dims_nc_forecast + parameter (num_dims_nc_forecast=3) ! number of dimensions is 3 for all 2d fields used + + !Dimensions of the netcdf files that are read + integer dim_length_nc_forecast(num_dims_nc_forecast) + integer dim_start_nc_forecast(num_dims_nc_forecast) + data dim_start_nc_forecast /1, 1, 1/ ! start at first value + + !Dimensions of the netcdf files that are used + integer end_dim_nc_forecast(num_dims_nc_forecast) + integer start_dim_nc_forecast(num_dims_nc_forecast) + + !3d data. Reorganised for memory reduction + integer temperature_index_forecast,relhumidity_index_forecast,cloudfraction_index_forecast,precip_index_forecast,x_wind_index_forecast,y_wind_index_forecast,speed_wind_index_forecast,dir_wind_index_forecast,pressure_index_forecast,longwaveradiation_index_forecast,shortwaveradiation_index_forecast + parameter (temperature_index_forecast=1,relhumidity_index_forecast=2,cloudfraction_index_forecast=3,precip_index_forecast=4,speed_wind_index_forecast=5,dir_wind_index_forecast=6,pressure_index_forecast=7,longwaveradiation_index_forecast=8,shortwaveradiation_index_forecast=9) + !TODO: Might be ok to remove x_wind_index_forecast and y_wind_index_forecast + + !2d data + integer lat_index_forecast,lon_index_forecast + parameter (lat_index_forecast=10,lon_index_forecast=11) + + integer num_var_nc_forecast + parameter (num_var_nc_forecast=11) ! number of variables + + character(256) var_name_nc_forecast(num_var_nc_forecast) + character(256) dim_name_nc_forecast(num_dims_nc_forecast) + + !dimension netcdf fields + integer x_index_forecast,y_index_forecast,time_index_forecast + parameter (x_index_forecast=1,y_index_forecast=2,time_index_forecast=3) + !---------------------------------------------------------------------------------------------------------------------------------------------- !Dimensions for terrain netcdf file integer terrain_index,num_var_terrain_nc,num_dims_terrain_nc @@ -101,6 +135,7 @@ module NORTRIP_multiroad_index_definitions !Declare netcdf files real, allocatable :: var1d_nc(:,:) double precision, allocatable :: var1d_time_nc(:) + double precision, allocatable :: var1d_time_nc_old(:) real, allocatable :: var2d_nc(:,:,:) real, allocatable :: var3d_nc(:,:,:,:) real angle_nc @@ -110,6 +145,14 @@ module NORTRIP_multiroad_index_definitions real, allocatable :: var2d_nc2(:,:,:) real, allocatable :: var3d_nc2(:,:,:,:) real dgrid_nc2(2) + + real, allocatable :: var1d_nc_forecast(:,:) + real, allocatable :: var2d_nc_forecast(:,:,:) + real, allocatable :: var3d_nc_forecast(:,:,:,:) + real dgrid_nc_forecast(2) + + integer, allocatable :: date_nc(:,:) + integer, allocatable :: date_nc_forecast(:,:) !Road link (rl) indexes integer x1_rl_index,x2_rl_index,y1_rl_index,y2_rl_index,z1_rl_index,z2_rl_index,width_rl_index @@ -147,8 +190,8 @@ module NORTRIP_multiroad_index_definitions parameter (N_week_index=1,HDV_week_index=2,LDV_week_index=3,V_week_index=4) integer num_week_traffic parameter (num_week_traffic=4) - integer hours_in_week,days_in_week,hours_in_day,seconds_in_hour,months_in_year - parameter (hours_in_week=168,days_in_week=7,hours_in_day=24,seconds_in_hour=3600,months_in_year=12) + integer hours_in_week,days_in_week,hours_in_day,seconds_in_hour,months_in_year,minutes_in_hour + parameter (hours_in_week=168,days_in_week=7,hours_in_day=24,seconds_in_hour=3600,months_in_year=12,minutes_in_hour=60) integer dir1_index,dir2_index,dirall_index,num_week_emission parameter (dir1_index=1,dir2_index=2,dirall_index=3,num_week_emission=3) @@ -235,6 +278,7 @@ module NORTRIP_multiroad_index_definitions character(256) pathfilename_mainfile !Declare file and path names for netcdf files character(256) filename_nc_template + character(256) infile_meteo_obs_netcdf_data_template character(256) filename_alternative_nc_template character(256) filename_nc character(256) filename_alternative_nc @@ -244,6 +288,10 @@ module NORTRIP_multiroad_index_definitions character(256) filename_nc2 character(256) pathname_nc2 character(256) pathfilename_nc2 + character(256) filename_nc_forecast_template + character(256) filename_nc_forecast + character(256) pathname_nc_forecast + character(256) pathfilename_nc_forecast !Declare file and path names for input roadlink files character(256) filename_rl(2) character(256) pathname_rl(2) @@ -280,6 +328,9 @@ module NORTRIP_multiroad_index_definitions character(256) filename_init_in character(256) pathname_init_in character(256) pathfilename_init_in + !Declare file and path names for input initialisation file on netcdf format + character(256) filename_init_in_netcdf + character(256) pathfilename_init_in_netcdf !Declare file and path names for output initialisation file character(256) filename_init_out character(256) pathname_init_out @@ -318,6 +369,7 @@ module NORTRIP_multiroad_index_definitions character(256) filename_log_NORTRIP character(256) path_init character(256) filename_init + character(256) filename_init_netcdf character(256) path_init_out character(256) path_output_emis character(256) filename_output_emis @@ -332,6 +384,8 @@ module NORTRIP_multiroad_index_definitions character(256) filename_meteo_obs_metadata character(256) inpath_meteo_obs_data character(256) infile_meteo_obs_data + character(256) inpath_meteo_obs_netcdf_data + character(256) infile_meteo_obs_netcdf_data !Regional EF and studded tyre data character(256) inpath_region_EF character(256) infile_region_EF @@ -382,7 +436,11 @@ module NORTRIP_multiroad_index_definitions integer n_hours_input integer start_dayofweek_input integer end_time_index_meteo_obs,start_time_index_meteo_obs - + integer, dimension(num_date_index) :: start_date_meteo_obs + integer, dimension(num_date_index) :: end_date_meteo_obs + integer :: timesteps_in_hour + real :: timestep + !Input character arrays for time character(256) start_date_and_time character(256) end_date_and_time @@ -479,9 +537,12 @@ module NORTRIP_multiroad_index_definitions parameter (num_replace_meteo_with_obs_input=10) integer :: replace_meteo_with_obs=0 integer :: replace_meteo_with_yr=0 + integer :: replace_meteo_with_met_forecast=0 integer :: replace_which_meteo_with_obs_input(num_replace_meteo_with_obs_input)=0 integer :: replace_which_meteo_with_obs(num_var_meteo)=0 integer, allocatable :: save_meteo_index(:) + logical :: read_obs_from_netcdf = .True. + !Dimensions of the obs meteo file that is used integer end_dim_meteo_obs @@ -489,7 +550,7 @@ module NORTRIP_multiroad_index_definitions !Use the same indexes for the observed as for the modelled meteorology character(256) var_name_meteo_obs(num_var_meteo) - integer n_meteo_obs_date + integer n_meteo_obs_date real, allocatable :: meteo_obs_data(:,:,:) real, allocatable :: meteo_obs_data_final(:,:) @@ -503,6 +564,8 @@ module NORTRIP_multiroad_index_definitions character(256), allocatable :: meteo_obs_name(:) real, allocatable :: meteo_obs_position(:,:) logical :: meteo_obs_data_available=.false. + + integer, allocatable :: obs_exist(:) !! store the time indexes where observations is available within the simulation date range. integer meteo_obs_height_index,meteo_obs_lat_index,meteo_obs_lon_index,meteo_obs_x_index,meteo_obs_y_index,num_meteo_obs_position parameter (meteo_obs_height_index=1,meteo_obs_lat_index=2,meteo_obs_lon_index=3,meteo_obs_x_index=4,meteo_obs_y_index=5) @@ -524,19 +587,25 @@ module NORTRIP_multiroad_index_definitions character(1) slash character(8) delete_file_command - integer :: number_of_time_steps=0 + integer :: number_of_time_steps=0 !Number of time steps to read from netcdf files. If 0 then reads all data in netcdf files. Can be modified in config file. + real :: scaling_for_relaxation=0 !! e double precision meteo_nc_projection_attributes(10) double precision meteo_nc2_projection_attributes(10) + double precision meteo_nc_forecast_projection_attributes(10) integer UTM_projection_index,RDM_projection_index,LCC_projection_index,LL_projection_index parameter (UTM_projection_index=1,RDM_projection_index=2,LCC_projection_index=3,LL_projection_index=4) integer :: meteo_nc_projection_type=LCC_projection_index integer :: meteo_nc2_projection_type=LCC_projection_index + integer :: meteo_nc_forecast_projection_type=LCC_projection_index logical, allocatable :: meteo_nc2_available(:) logical, allocatable :: meteo_var_nc2_available(:,:) + + logical :: meteo_nc_forecast_available + logical, allocatable :: meteo_var_nc_forecast_available(:,:) - character(256) projection_name_nc,projection_name_nc2 - + character(256) projection_name_nc,projection_name_nc2,projection_name_nc_forecast + !Auto activity data real, allocatable :: multi_salting_hour(:,:) real, allocatable :: multi_delay_salting_day(:) @@ -634,7 +703,7 @@ end module NORTRIP_multiroad_index_definitions !========================================================================== ! set_constant_values !========================================================================== - subroutine set_constant_values +subroutine set_constant_values use NORTRIP_multiroad_index_definitions @@ -655,12 +724,11 @@ subroutine set_constant_values var_name_nc(elevation_index)='surface_elevation' var_name_nc(surface_temperature_index)='air_temperature_0m' var_name_nc(precip_snow_index)='snowfall_amount_acc' - + var_name_nc2(lat_index2)='lat' var_name_nc2(lon_index2)='lon' var_name_nc2(elevation_index2)='altitude' var_name_nc2(temperature_index2)='air_temperature_2m' - var_name_nc2(relhumidity_index2)='relative_humidity_2m' var_name_nc2(dewpoint_index2)='dew_point_temperature_2m' var_name_nc2(cloudfraction_index2)='cloud_area_fraction' @@ -670,6 +738,18 @@ subroutine set_constant_values var_name_nc2(speed_wind_index2)='wind_speed_10m' var_name_nc2(dir_wind_index2)='wind_direction_10m' + var_name_nc_forecast(lat_index_forecast)='latitude' + var_name_nc_forecast(lon_index_forecast)='longitude' + var_name_nc_forecast(pressure_index_forecast)='air_pressure_at_sea_level' + var_name_nc_forecast(temperature_index_forecast)='air_temperature_2m' + var_name_nc_forecast(relhumidity_index_forecast)='relative_humidity_2m' + var_name_nc_forecast(cloudfraction_index_forecast)='cloud_area_fraction' + var_name_nc_forecast(speed_wind_index_forecast)='wind_speed_10m' + var_name_nc_forecast(dir_wind_index_forecast)='wind_direction_10m' + var_name_nc_forecast(precip_index_forecast)='precipitation_amount' + var_name_nc_forecast(shortwaveradiation_index_forecast)='integral_of_surface_downwelling_shortwave_flux_in_air_wrt_time' + var_name_nc_forecast(longwaveradiation_index_forecast)='integral_of_surface_downwelling_longwave_flux_in_air_wrt_time' + dim_name_nc(x_index)='x' dim_name_nc(y_index)='y' dim_name_nc(time_index)='time' @@ -680,6 +760,11 @@ subroutine set_constant_values dim_name_nc2(time_index2)='time' projection_name_nc2='projection_lcc' + dim_name_nc_forecast(x_index_forecast)='x' + dim_name_nc_forecast(y_index_forecast)='y' + dim_name_nc_forecast(time_index_forecast)='time' + projection_name_nc_forecast='projection_lcc' + dim_name_terrain_nc(x_index)='x' dim_name_terrain_nc(y_index)='y' var_name_terrain_nc(terrain_index)='Band1' @@ -687,8 +772,8 @@ subroutine set_constant_values missing_data=-99.0 n_roadlinks=1 lapse_rate=-0.005 !(K/m) - precip_cutoff=0.005 !Must be more than this to give precipitation (was 0.05 until 07.01.2021, increased to include fog droplet deposition) - + precip_cutoff=0.000000005 !Must be more than this to give precipitation (was 0.05 until 07.01.2021, increased to include fog droplet deposition) + !Stnr Year Month Day Time(NMT) UU PO TA RR_1 FF DD QSI NN TV var_name_meteo_obs(:)='' var_name_meteo_obs(pressure_index)='PO' @@ -715,5 +800,5 @@ subroutine set_constant_values endif - end subroutine set_constant_values +end subroutine set_constant_values diff --git a/NORTRIP_multiroad_extra_functions.f90 b/NORTRIP_multiroad_extra_functions.f90 index f5b2505..4c72cc4 100644 --- a/NORTRIP_multiroad_extra_functions.f90 +++ b/NORTRIP_multiroad_extra_functions.f90 @@ -63,3 +63,53 @@ subroutine distribute_rain_snow(temperature,precipitation,flag_index,rain,snow) end subroutine distribute_rain_snow ! ###################################################################### + function relax_meteo_variable_Karisto(X_F, X_FO, X_O, t,dt,e_folding_time) + !! Used to relax meteorological variables between model and observed values + !! Based on Crevier and Delage, 2001 and Karisto et al. 2016 + + !! Input + real, intent(in) :: X_F !! Model value + real, intent(in) :: X_FO !! Model value at the time of the last observation + real, intent(in) :: X_O !! The last observation value + integer, intent(in) :: t !! current timestep + real, intent(in) :: dt !! timestep size + real, intent(in) :: e_folding_time !! [hours] + + !local: + real :: t_c + + + !Out + real :: relax_meteo_variable_Karisto + + t_c = e_folding_time/dt + + relax_meteo_variable_Karisto = X_F - (X_FO - X_O)*exp(-real(t/t_c)) + + end function relax_meteo_variable_Karisto +! ###################################################################### + function relax_meteo_variable_gaussian(X_F, X_FO, X_O, t,dt,scaling_parameter) + !! Used to relax meteorological variables between model and observed values + !! Based on Crevier and Delage, 2001 and Karisto et al. 2016 + + !! Input + real, intent(in) :: X_F !! Model value + real, intent(in) :: X_FO !! Model value at the time of the last observation + real, intent(in) :: X_O !! The last observation value + integer, intent(in) :: t !! current timestep + real, intent(in) :: dt !! timestep size + real, intent(in) :: scaling_parameter !! [hours] + + !local: + real :: scale_time + + + !Out + real :: relax_meteo_variable_gaussian + + scale_time = scaling_parameter/dt + + relax_meteo_variable_gaussian = X_F - (X_FO - X_O)*exp(-real(t/scale_time)**2) + + end function relax_meteo_variable_gaussian +! ###################################################################### \ No newline at end of file diff --git a/NORTRIP_multiroad_find_init_file.f90 b/NORTRIP_multiroad_find_init_file.f90 index 82d04a2..f83dcac 100644 --- a/NORTRIP_multiroad_find_init_file.f90 +++ b/NORTRIP_multiroad_find_init_file.f90 @@ -6,13 +6,13 @@ subroutine NORTRIP_multiroad_find_init_file implicit none - integer unit_in - integer exists + logical exists integer init_date(num_date_index) integer init_counter logical init_found character(256) filename_NORTRIP_data_temp character(256) filename_init_start + character(256) filename_init_start_netcdf write(unit_logfile,'(A)') '================================================================' write(unit_logfile,'(A)') 'Finding initialisation data (NORTRIP_multiroad_find_init_file)' @@ -31,13 +31,23 @@ subroutine NORTRIP_multiroad_find_init_file filename_init_in=trim(filename_NORTRIP_data_temp)//'_init.txt' filename_init_start=filename_init_in pathfilename_init_in=trim(pathname_init_in)//trim(filename_init_in) - !Update the date string 3 times incase there are more than one bracket - call date_to_datestr_bracket(init_date,pathfilename_init_in,pathfilename_init_in) - call date_to_datestr_bracket(init_date,pathfilename_init_in,pathfilename_init_in) - call date_to_datestr_bracket(init_date,pathfilename_init_in,pathfilename_init_in) - + !Update the date string 3 times incase there are more than one bracket + call date_to_datestr_bracket(init_date,pathfilename_init_in,pathfilename_init_in) + call date_to_datestr_bracket(init_date,pathfilename_init_in,pathfilename_init_in) + call date_to_datestr_bracket(init_date,pathfilename_init_in,pathfilename_init_in) + + filename_init_in_netcdf=trim(filename_NORTRIP_data_temp)//'_init.nc' + filename_init_start_netcdf=filename_init_in_netcdf + pathfilename_init_in=trim(pathname_init_in)//trim(filename_init_in_netcdf) + !Update the date string 3 times incase there are more than one bracket + call date_to_datestr_bracket(init_date,pathfilename_init_in_netcdf,pathfilename_init_in_netcdf) + call date_to_datestr_bracket(init_date,pathfilename_init_in_netcdf,pathfilename_init_in_netcdf) + call date_to_datestr_bracket(init_date,pathfilename_init_in_netcdf,pathfilename_init_in_netcdf) + write(unit_logfile,'(A,A)') ' Looking for NORTRIP initialisation file: ', trim(filename_init_start) + write(unit_logfile,'(A,A)') ' Looking for NORTRIP initialisation netcdf file: ', trim(filename_init_start_netcdf) + !============================Look for init file in text format (_init.txt)================================================== !Test existence of the filename. If does not exist then update by subtracting 1 day init_counter=0 init_found=.false. @@ -72,9 +82,49 @@ subroutine NORTRIP_multiroad_find_init_file write(unit_logfile,'(A,A,A,I4,A)') ' Found previous NORTRIP initialisation file ',trim(pathfilename_init_in),' from ',init_counter-1,' hours before' endif else - write(unit_logfile,'(A,A)') ' WARNING: No initialisation file found in the last 30 days ',trim(pathfilename_init_in) + write(unit_logfile,'(A,A)') ' WARNING: No .txt initialisation file found in the last 30 days ',trim(pathfilename_init_in) filename_init_in='' endif + !========================================================================================================================== + !!==============================Look for init file in netcdf format========================================================= + !Test existence of the filename. If does not exist then update by subtracting 1 day + init_counter=0 + init_found=.false. + init_date=start_date_input + do while(init_counter.lt.30*24.and..not.init_found) + !Set the template NORTRIP filename using the given dates + call date_to_datestr_bracket(init_date,filename_NORTRIP_template,filename_NORTRIP_data_temp) + filename_init_in_netcdf=trim(filename_NORTRIP_data_temp)//'_init.nc' + pathfilename_init_in_netcdf=trim(pathname_init_in)//trim(filename_init_in_netcdf) + !Update the date string 3 times incase there are more than one bracket + call date_to_datestr_bracket(init_date,pathfilename_init_in_netcdf,pathfilename_init_in_netcdf) + call date_to_datestr_bracket(init_date,pathfilename_init_in_netcdf,pathfilename_init_in_netcdf) + call date_to_datestr_bracket(init_date,pathfilename_init_in_netcdf,pathfilename_init_in_netcdf) + + init_counter=init_counter+1 + inquire(file=trim(pathfilename_init_in_netcdf),exist=exists) + if (exists) then + init_found=.true. + else + !Wind back the time one hour to search for a valid init file + !write(*,'(A,A,A)') ' WARNING: No initialisation file found for ', trim(filename_init_in_netcdf),'. Trying one day earlier' + !call incrtm(-hours_between_init,init_date(1),init_date(2),init_date(3),init_date(4)) + call incrtm(-1,init_date(1),init_date(2),init_date(3),init_date(4)) + endif + + enddo + + if (init_found) then + if (init_counter.eq.1) then + write(unit_logfile,'(A,A)') ' Found correct NORTRIP initialisation netcdf file: ',trim(filename_init_in_netcdf) + else + write(unit_logfile,'(A,A,A,I4,A)') ' Found previous NORTRIP initialisation netcdf file ',trim(filename_init_in_netcdf),' from ',init_counter-1,' hours before' + endif + else + write(unit_logfile,'(A,A)') ' WARNING: No .nc initialisation file found in the last 30 days ',trim(filename_init_in_netcdf) + filename_init_in_netcdf='' + endif + !!========================================================================================================================== - end subroutine NORTRIP_multiroad_find_init_file \ No newline at end of file +end subroutine NORTRIP_multiroad_find_init_file \ No newline at end of file diff --git a/NORTRIP_multiroad_read_main_inputs.f90 b/NORTRIP_multiroad_read_main_inputs.f90 index e3a72f0..5a8ec0c 100644 --- a/NORTRIP_multiroad_read_main_inputs.f90 +++ b/NORTRIP_multiroad_read_main_inputs.f90 @@ -50,21 +50,21 @@ subroutine NORTRIP_read_main_inputs !Place the start date string into the start date array character_length = LEN_TRIM(start_date_and_time) - if (character_length >= 10) then - read(start_date_and_time, *) start_date_input(year_index),start_date_input(month_index),start_date_input(day_index),start_date_input(hour_index) - start_date_input(minute_index:second_index)=0 + if (character_length >= 16) then + read(start_date_and_time, *) start_date_input(year_index),start_date_input(month_index),start_date_input(day_index),start_date_input(hour_index),start_date_input(minute_index) + start_date_input(second_index)=0 else - write(unit_logfile,'(A)') ' WARNING: "start_date_and_time" is too short. Using default date' + write(unit_logfile,'(A)') ' WARNING: "start_date_and_time" is too short, should be on the form yyyy,mm,dd,HH,MM. Using default date' start_date_input=start_date_default endif !Place the end date string into the end date array character_length = LEN_TRIM(end_date_and_time) - if (character_length >= 10) then - read(end_date_and_time, *) end_date_input(year_index),end_date_input(month_index),end_date_input(day_index),end_date_input(hour_index) - end_date_input(minute_index:second_index)=0 + if (character_length >= 16) then + read(end_date_and_time, *) end_date_input(year_index),end_date_input(month_index),end_date_input(day_index),end_date_input(hour_index),end_date_input(minute_index) + end_date_input(second_index)=0 else - write(unit_logfile,'(A)') ' WARNING: "end_date_and_time" is too short. Using default date' + write(unit_logfile,'(A)') ' WARNING: "end_date_and_time" is too short, should be on the form yyyy,mm,dd,HH,MM. Using default date' end_date_input=end_date_default endif @@ -73,11 +73,11 @@ subroutine NORTRIP_read_main_inputs open(unit_logfile,file=filename_log,status='old',position='append') endif - write(unit_logfile,'(A,4I5)') ' Start date: ', start_date_input(year_index),start_date_input(month_index),start_date_input(day_index),start_date_input(hour_index) - write(unit_logfile,'(A,4I5)') ' End date: ', end_date_input(year_index),end_date_input(month_index),end_date_input(day_index),end_date_input(hour_index) + write(unit_logfile,'(A,5I5)') ' Start date: ', start_date_input(year_index),start_date_input(month_index),start_date_input(day_index),start_date_input(hour_index),start_date_input(minute_index) + write(unit_logfile,'(A,5I5)') ' End date: ', end_date_input(year_index),end_date_input(month_index),end_date_input(day_index),end_date_input(hour_index),end_date_input(minute_index) !Calculate the number of hours between end and start dates - n_hours_input=int((date_to_number(end_date_input,ref_year)-date_to_number(start_date_input,ref_year))*24.+.5)+1 + n_hours_input=int((date_to_number(end_date_input,ref_year)-date_to_number(start_date_input,ref_year))*24./timestep+.5)+1 !This is only valid for 3 hourly EMEP data. Taken out !if (index(meteo_data_type,'emep').gt.0) then ! n_hours_input=(n_hours_input-1)/3+1 @@ -89,25 +89,27 @@ subroutine NORTRIP_read_main_inputs write(unit_logfile,'(A)') ' ERROR: Number of hours is 0 or less. Stopping' STOP 5 endif - write(unit_logfile,'(A,4I5)') ' Number of hours: ', n_hours_input + write(unit_logfile,'(A,4I5)') ' Number of timesteps: ', n_hours_input !Allocate a time array to the input data - allocate (date_data(num_date_index,n_hours_input)) + allocate (date_data(num_date_index,n_hours_input)) !TODO: Should this array still use hours to determine second dimension, or should it be determined by the timestep? Best option to rename n_hours_input? It is also unclear what this "input" refers to? The dates that have been given as input? date_data=0 - !date_data(1,t)=start_date_input - do t=1,n_hours_input - a_temp=start_date_input - call incrtm(t-1,a_temp(1),a_temp(2),a_temp(3),a_temp(4)) - date_data(:,t)=a_temp - !write(*,*) date_data(:,t) - !num_temp=date_to_number(a_temp) - !call number_to_date(num_temp,a_temp) - !write(*,*) a_temp - - enddo + if ( timestep .eq. 1. ) then + do t=1,n_hours_input + a_temp=start_date_input + call incrtm(t-1,a_temp(1),a_temp(2),a_temp(3),a_temp(4)) + date_data(:,t)=a_temp + enddo + else + date_data(:,1) = start_date_input + do t=0,n_hours_input-1 + a_temp=start_date_input + call minute_increment(int(minutes_in_hour*timestep)*t,a_temp(1),a_temp(2),a_temp(3),a_temp(4),a_temp(5)) + date_data(:,t+1)=a_temp + enddo + end if - !Fill in any time templates. Not in the NORTRIP paths as this must be set later !These meteo path names insert dates when reading the data, in case the paths need to be changed !call date_to_datestr_bracket(start_date_input,pathname_nc,pathname_nc) @@ -119,6 +121,7 @@ subroutine NORTRIP_read_main_inputs call date_to_datestr_bracket(start_date_input,filename_nc_template,filename_nc) call date_to_datestr_bracket(start_date_input,filename_alternative_nc_template,filename_alternative_nc) call date_to_datestr_bracket(start_date_input,filename_nc2_template,filename_nc2) + call date_to_datestr_bracket(start_date_input,filename_nc_forecast_template,filename_nc_forecast) call date_to_datestr_bracket(start_date_input,filename_rl(1),filename_rl(1)) call date_to_datestr_bracket(start_date_input,filename_rl(2),filename_rl(2)) call date_to_datestr_bracket(start_date_input,filename_traffic,filename_traffic) @@ -131,8 +134,11 @@ subroutine NORTRIP_read_main_inputs call date_to_datestr_bracket(start_date_input,filename_alternative_nc_template,filename_alternative_nc) call date_to_datestr_bracket(start_date_input,inpath_meteo_obs_data,inpath_meteo_obs_data) call date_to_datestr_bracket(start_date_input,infile_meteo_obs_data,infile_meteo_obs_data) + call date_to_datestr_bracket(start_date_input,inpath_meteo_obs_netcdf_data,inpath_meteo_obs_netcdf_data) + call date_to_datestr_bracket(start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + call date_to_datestr_bracket(start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) call date_to_datestr_bracket(start_date_input,path_outputdata,path_outputdata) - + !Roadlink ID activity files call date_to_datestr_bracket(start_date_input,inpath_activity,inpath_activity) call date_to_datestr_bracket(start_date_input,infile_activity,infile_activity) @@ -249,6 +255,7 @@ subroutine read_NORTRIP_multiroad_pathnames city_str(2)=match_string_char('city_str2',unit_in,unit_logfile,'') pathname_nc=match_string_char('inpath_meteo_nc',unit_in,unit_logfile,'') pathname_nc2=match_string_char('inpath_meteo_nc2',unit_in,unit_logfile,'') + pathname_nc_forecast=match_string_char('inpath_meteo_nc_forecast',unit_in,unit_logfile,'') pathname_rl(1)=match_string_char('inpath_static_road_1',unit_in,unit_logfile,'') pathname_rl(2)=match_string_char('inpath_static_road_2',unit_in,unit_logfile,'') pathname_traffic=match_string_char('inpath_dynamic_road',unit_in,unit_logfile,'') @@ -259,6 +266,7 @@ subroutine read_NORTRIP_multiroad_pathnames filename_nc_template=match_string_char('infile_meteo_nc',unit_in,unit_logfile,'') filename_alternative_nc_template=match_string_char('infile_meteo_alternative_nc',unit_in,unit_logfile,'') filename_nc2_template=match_string_char('infile_meteo_nc2',unit_in,unit_logfile,'') + filename_nc_forecast_template=match_string_char('infile_meteo_nc_forecast',unit_in,unit_logfile,'') filename_rl(1)=match_string_char('infile_static_road_1',unit_in,unit_logfile,'') filename_rl(2)=match_string_char('infile_static_road_2',unit_in,unit_logfile,'') filename_traffic=match_string_char('infile_dynamic_road',unit_in,unit_logfile,'') @@ -302,7 +310,11 @@ subroutine read_NORTRIP_multiroad_pathnames DIFUTC_H=match_string_val('Time difference site',unit_in,unit_logfile,0.0) DIFUTC_H_traffic=match_string_val('Time difference traffic',unit_in,unit_logfile,0.0) missing_data=match_string_val('Missing data value',unit_in,unit_logfile,-999.) + timesteps_in_hour=match_string_int('Number of timesteps within one hour',unit_in,unit_logfile,1) + timestep = 1./timesteps_in_hour hours_between_init=match_string_int('Hours between saving init files',unit_in,unit_logfile,24) + hours_between_init = int(hours_between_init/timestep) + calculation_type=match_string_char('Calculation type',unit_in,unit_logfile,'normal') timevariation_type=match_string_char('Timevariation type',unit_in,unit_logfile,'normal') ID_dynamic_emission(pm25_index)=match_string_char('Model output ID PM2.5',unit_in,unit_logfile,'{no-index-in-main-config-file}') @@ -422,10 +434,13 @@ subroutine read_NORTRIP_multiroad_pathnames !Data for reading and replacing model data with observational data replace_meteo_with_obs=match_string_int('replace_meteo_with_obs',unit_in,unit_logfile,0) replace_meteo_with_yr=match_string_int('replace_meteo_with_yr',unit_in,unit_logfile,0) + replace_meteo_with_met_forecast=match_string_int('replace_meteo_with_met_forecast',unit_in,unit_logfile,0) wetbulb_snow_rain_flag=match_string_int('wetbulb_snow_rain_flag',unit_in,unit_logfile,wetbulb_snow_rain_flag) filename_meteo_obs_metadata=match_string_char('filename_meteo_obs_metadata',unit_in,unit_logfile,'') inpath_meteo_obs_data=match_string_char('inpath_meteo_obs_data',unit_in,unit_logfile,'') infile_meteo_obs_data=match_string_char('infile_meteo_obs_data',unit_in,unit_logfile,'') + inpath_meteo_obs_netcdf_data=match_string_char('inpath_meteo_obs_netcdf_data',unit_in,unit_logfile,'') + infile_meteo_obs_netcdf_data_template=match_string_char('infile_meteo_obs_netcdf_data',unit_in,unit_logfile,'') call match_string_multi_int('replace_which_meteo_with_obs',unit_in,unit_logfile,replace_which_meteo_with_obs_input(1:num_replace_meteo_with_obs_input),num_replace_meteo_with_obs_input) !pressure,temperature,relhumidity,cloudfraction,precip,shortwave_rad,longwave_rad,speed_wind,dir_wind,road_temperature if (replace_which_meteo_with_obs_input(1).ne.-999) then @@ -542,7 +557,7 @@ subroutine read_NORTRIP_multiroad_pathnames if (temp_int.eq.1) only_use_major_roadlinks=.true. number_of_time_steps=match_string_int('number_of_time_steps',unit_in,unit_logfile,0) - + scaling_for_relaxation=match_string_val('scaling_for_relaxation',unit_in,unit_logfile,0) if (unit_logfile.gt.0) then close(unit_logfile,status='keep') endif @@ -654,6 +669,9 @@ subroutine replace_NORTRIP_citystr filename_meteo_obs_metadata=replace_string_char(city_str(i),trim(temp_str),filename_meteo_obs_metadata) inpath_meteo_obs_data=replace_string_char(city_str(i),trim(temp_str),inpath_meteo_obs_data) infile_meteo_obs_data=replace_string_char(city_str(i),trim(temp_str),infile_meteo_obs_data) + + inpath_meteo_obs_netcdf_data=replace_string_char(city_str(i),trim(temp_str),inpath_meteo_obs_netcdf_data) + infile_meteo_obs_netcdf_data=replace_string_char(city_str(i),trim(temp_str),infile_meteo_obs_netcdf_data) !EF files inpath_region_EF=replace_string_char(city_str(i),trim(temp_str),inpath_region_EF) @@ -824,46 +842,36 @@ subroutine NORTRIP_multiroad_read_receptor_data if (use_only_special_links_flag.eq.2) then write(unit_logfile,'(a,i)') ' Using all road links in calculation. Saving only special links: ',n_save_links !Set the saving of links to all roads - !write(*,*) 'Here 1' + do i=1,n_roadlinks save_links(i)=i enddo - !write(*,*) 'Here 2' - !write(*,*) shape(inputdata_int_rl),n_roadlinks,roadindex_rl_index + n_save_links=n_roadlinks - !write(*,*) shape(save_links),n_save_links,savedata_rl_index - - !write(*,*) maxval(save_links),minval(save_links) - !write(*,*) 'Here min: ',inputdata_int_rl(roadindex_rl_index,minval(save_links)) - !write(*,*) 'Here max: ',inputdata_int_rl(roadindex_rl_index,maxval(save_links)) - !write(*,*) 'Here :',save_links(1),save_links(n_save_links) - !write(*,*) inputdata_int_rl(roadindex_rl_index,:) + do i=1,n_save_links inputdata_int_rl(roadindex_rl_index,save_links(i))=save_links(i) inputdata_int_rl(savedata_rl_index,save_links(i))=0 - !write(*,*) i,inputdata_int_rl(roadindex_rl_index,i) enddo endif - !write(*,*) 'Here 3' - + + !TODO: This should be fixed! Also, the "use_uEMEP_receptor_file" is used for avinor, even if does not involve uEMEP. !If api is in the receptor file name then read in a different way. - !This is not the best method for specifying file type and should be done differently + !This is not the best method for specifying file type and should be done differently if (index(filename_NORTRIP_receptors,'api').gt.0) use_uEMEP_receptor_file=.true. if (index(filename_NORTRIP_receptors,'category').gt.0) read_receptor_type=.true. - if (use_uEMEP_receptor_file) then unit_in=20 open(unit_in,file=filename_NORTRIP_receptors,access='sequential',status='old',readonly) write(unit_logfile,'(a)') ' Opening receptor file '//trim(filename_NORTRIP_receptors) rewind(unit_in) - !call NXTDAT(unit_in,nxtdat_flag) + !read the header to find out how many links there are read(unit_in,'(a)',ERR=19) temp_str1 k=0 - !write(*,*) trim(temp_str1) do while(.not.eof(unit_in)) k=k+1 if (read_receptor_type) then @@ -872,7 +880,11 @@ subroutine NORTRIP_multiroad_read_receptor_data else read(unit_in,*,ERR=19) name_receptor(k,1),lon_receptor(k),lat_receptor(k)!,h_receptor(k),name_receptor(k,2) h_receptor(k)=0 !0 height - type_receptor(k)=1 !AQ type + if ( calculation_type == "Avinor" ) then + type_receptor(k)=3 !runway type + else + type_receptor(k)=1 !AQ type + end if name_receptor(k,2)=name_receptor(k,1) !Name endif enddo @@ -915,10 +927,9 @@ subroutine NORTRIP_multiroad_read_receptor_data save_road_name(i)=name_receptor(k,1) call LL2UTM(1,utm_zone,lat_receptor(k),lon_receptor(k),save_road_y(i),save_road_x(i)) save_road_ospm_pos(i)=3 - save_road_receptor_type(i)=type_receptor(k) + save_road_receptor_type(i)=type_receptor(k) !TODO: type_receptor(k) was hardcoded to 1 further up, which means that save_road_receptor_type was not 3 for runways, which it should be(?). I've now changed it to 3, but this needs some more thought save_road_name2(i)=name_receptor(k,2) - !write(unit_logfile,'(I12,I20,i20,A32,2f12.1,I32)') i,save_road_index(i),save_road_id(i),trim(save_road_name(i)),save_road_x(i),save_road_y(i),save_road_ospm_pos(i) endif enddo n_save_road=i @@ -977,73 +988,68 @@ subroutine NORTRIP_multiroad_read_receptor_data i_link_adt_max=0 do i=1,n_roadlinks !Only look in the correct ID - distance_to_link2=sqrt((inputdata_rl(x0_rl_index,i)-save_road_x(j))**2+(inputdata_rl(y0_rl_index,i)-save_road_y(j))**2) + distance_to_link2=sqrt((inputdata_rl(x0_rl_index,i)-save_road_x(j))**2+(inputdata_rl(y0_rl_index,i)-save_road_y(j))**2) !TODO: Why is this called 2?? + !Do not look for roads more than 2500 m away or look for tunnel portal jets, defined as 6 in NORTRIP. Should be specified better as parameter if (distance_to_link2.lt.distance_to_link_min2.and.inputdata_int_rl(roadstructuretype_rl_index,i).ne.tunnelportal_roadtype) then - do ii=1,inputdata_int_rl(n_subnodes_rl_index,i)-1 - - call distrl(save_road_x(j),save_road_y(j),inputdata_rl_sub(x1_rl_index,ii,i),inputdata_rl_sub(y1_rl_index,ii,i),inputdata_rl_sub(x2_rl_index,ii,i),inputdata_rl_sub(y2_rl_index,ii,i),temp_val,temp_val2,distance_to_link)!(X0,Y0,X1,Y1,X2,Y2,XM,YM,DM) - !call distrl(save_road_x(j),save_road_y(j),inputdata_rl(x1_rl_index,i),inputdata_rl(y1_rl_index,i),inputdata_rl(x2_rl_index,i),inputdata_rl(y2_rl_index,i),temp_val,temp_val2,distance_to_link)!(X0,Y0,X1,Y1,X2,Y2,XM,YM,DM) - !write(*,'(i8,i8,f12.0,f12.0,f12.0,f12.0,f12.0,f12.0,f12.0,f12.0,f12.0)') j,i,save_road_x(j),save_road_y(j),inputdata_rl(x1_rl_index,i),inputdata_rl(y1_rl_index,i),temp_val,temp_val2,distance_to_link,distance_to_link2,distance_to_link_min - !if (distance_to_link.lt.distance_to_link_min) then - ! distance_to_link_min=distance_to_link - ! i_link_distance_min=i - !endif - adt_of_link=inputdata_rl(adt_rl_index,i) - !if (inputdata_int_rl(roadstructuretype_rl_index,i).eq.runway_roadtype) then - ! !Set artificially high for runways so it will always be selected if it is within min_search_distance - ! adt_of_link=1e12 - !endif - - !Find the AQ stations, largest ADT within 100 m, when the same ADT then the closest - if (save_road_receptor_type(j).eq.receptor_aq_index) then - !If the ADT is equal to or higher and the distance is less than the maximum allowed - if (adt_of_link.ge.adt_of_link_max.and.distance_to_link.lt.min_search_distance) then - !if the ADT is higher or if it is the same and the ditance is less than the shortest current - if (adt_of_link.gt.adt_of_link_max.or.(adt_of_link.ge.adt_of_link_max.and.distance_to_link.lt.distance_to_link_min)) then - adt_of_link_max=adt_of_link - i_link_adt_max=i - distance_to_link_min=distance_to_link - i_link_distance_min=i - !write(*,*) i_link_adt_max,adt_of_link_max,distance_to_link_min - endif - endif - endif - - !Find the SVV and custom stations, closest road link - if (save_road_receptor_type(j).eq.receptor_svv_index.or.save_road_receptor_type(j).eq.receptor_custom_index.or.save_road_receptor_type(j).eq.receptor_camera_index) then - if (distance_to_link.lt.distance_to_link_min) then - adt_of_link_max=adt_of_link - i_link_adt_max=i - distance_to_link_min=distance_to_link - i_link_distance_min=i - endif - endif + do ii=1,inputdata_int_rl(n_subnodes_rl_index,i)-1 + call distrl(save_road_x(j),save_road_y(j),inputdata_rl_sub(x1_rl_index,ii,i),inputdata_rl_sub(y1_rl_index,ii,i),inputdata_rl_sub(x2_rl_index,ii,i),inputdata_rl_sub(y2_rl_index,ii,i),temp_val,temp_val2,distance_to_link)!(X0,Y0,X1,Y1,X2,Y2,XM,YM,DM) - !if (j.eq.1247) then - ! write(*,'(5i,2f12.1)') save_road_receptor_type(j),type_receptor(j),receptor_custom_index,i,ii,i_link_distance_min,distance_to_link,distance_to_link_min - !endif - - !Find the Runway stations, closest road link and the link must be a runway - if (save_road_receptor_type(j).eq.receptor_runway_index.and.inputdata_int_rl(roadstructuretype_rl_index,i).eq.runway_roadtype) then - if (distance_to_link.lt.distance_to_link_min) then - adt_of_link_max=adt_of_link - i_link_adt_max=i - distance_to_link_min=distance_to_link - i_link_distance_min=i - endif - endif + adt_of_link=inputdata_rl(adt_rl_index,i) + if (inputdata_int_rl(roadstructuretype_rl_index,i).eq.runway_roadtype) then + !Set artificially high for runways so it will always be selected if it is within min_search_distance + adt_of_link=1e12 + endif + + !Find the AQ stations, largest ADT within 100 m, when the same ADT then the closest + if (save_road_receptor_type(j).eq.receptor_aq_index) then + !If the ADT is equal to or higher and the distance is less than the maximum allowed + if (adt_of_link.ge.adt_of_link_max.and.distance_to_link.lt.min_search_distance) then + !if the ADT is higher or if it is the same and the ditance is less than the shortest current + if (adt_of_link.gt.adt_of_link_max.or.(adt_of_link.ge.adt_of_link_max.and.distance_to_link.lt.distance_to_link_min)) then + adt_of_link_max=adt_of_link + i_link_adt_max=i + distance_to_link_min=distance_to_link + i_link_distance_min=i + endif + endif + endif + + !Find the SVV and custom stations, closest road link + if (save_road_receptor_type(j).eq.receptor_svv_index.or.save_road_receptor_type(j).eq.receptor_custom_index.or.save_road_receptor_type(j).eq.receptor_camera_index) then + if (distance_to_link.lt.distance_to_link_min) then + adt_of_link_max=adt_of_link + i_link_adt_max=i + distance_to_link_min=distance_to_link + i_link_distance_min=i + endif + endif - enddo + !if (j.eq.1247) then + ! write(*,'(5i,2f12.1)') save_road_receptor_type(j),type_receptor(j),receptor_custom_index,i,ii,i_link_distance_min,distance_to_link,distance_to_link_min + !endif + + !Find the Runway stations, closest road link and the link must be a runway + if (save_road_receptor_type(j).eq.receptor_runway_index.and.inputdata_int_rl(roadstructuretype_rl_index,i).eq.runway_roadtype) then + if (distance_to_link.lt.distance_to_link_min) then + adt_of_link_max=adt_of_link + i_link_adt_max=i + distance_to_link_min=distance_to_link + i_link_distance_min=i + endif + endif + + enddo endif - !write(*,*) j,i,distance_to_link_min !save_road_x(j),save_road_y(j),inputdata_int_rl(id_rl_index,i),inputdata_rl(x1_rl_index,i),inputdata_rl(y2_rl_index,i) + enddo !write(*,'(2i,3f12.1)') j,i_link_distance_min,distance_to_link_min,save_road_x(j),save_road_y(j) - !if (i_link_distance_min.gt.0.and.distance_to_link_min.lt.100.) then + if (i_link_distance_min.gt.0.and.i_link_adt_max.gt.0.and.distance_to_link_min.le.min_search_distance & .or.(distance_to_link_min.lt.min_save_distance_custom.and.save_road_receptor_type(j).eq.receptor_custom_index) & .or.(distance_to_link_min.lt.min_save_distance_camera.and.save_road_receptor_type(j).eq.receptor_camera_index) & .or.(distance_to_link_min.lt.min_save_distance_runway.and.save_road_receptor_type(j).eq.receptor_runway_index)) then + jj=jj+1 !i_link_distance_min=i_link_adt_max inputdata_int_rl(savedata_rl_index,i_link_distance_min)=1 @@ -1052,13 +1058,11 @@ subroutine NORTRIP_multiroad_read_receptor_data !inputdata_int_rl(id_rl_index,i_link_distance_min)=save_road_id(j) save_road_index(jj)=i_link_distance_min save_meteo_index(jj)=j - !write(*,*) ':::',jj,i_link_distance_min,distance_to_link_min,inputdata_rl(x1_rl_index,i_link_distance_min),inputdata_rl(y1_rl_index,i_link_distance_min) write(unit_logfile,'(a,i8,a24,f12.2,i12,i12,f12.0,i12,i12,a48)') 'Special links (i,name,dist,index,ID,ADT,linktype,rectype,recname): ',jj,trim(inputdata_char_rl(roadname_rl_index,i_link_distance_min)) & ,distance_to_link_min,save_road_index(jj),inputdata_int_rl(id_rl_index,save_road_index(jj)),inputdata_rl(adt_rl_index,save_road_index(jj)),inputdata_int_rl(roadstructuretype_rl_index,save_road_index(jj)) & ,save_road_receptor_type(j),trim(adjustl(save_road_name2(j))) else write(unit_logfile,'(a,i8,a24,i8,a48,f12.2)') 'No links found (i,name,rectype,recname,dist): ',j,trim(adjustl(save_road_name(j))),save_road_receptor_type(j),trim(adjustl(save_road_name2(j))),distance_to_link_min - endif enddo write(unit_logfile,'(a,i)') ' Number of roads found near (<100 m) of receptor points = ', jj @@ -1070,7 +1074,6 @@ subroutine NORTRIP_multiroad_read_receptor_data n_save_links=jj save_links(1:n_save_links)=save_road_index(1:n_save_links) write(unit_logfile,'(a,i12)') ' Calculating and saving only selected link index: ',save_links(1:n_save_links) - !write(unit_logfile,'(a,i12)') ' Saving only selected roadlink index: ',inputdata_int_rl(roadindex_rl_index,save_links(1:n_save_road)) write(unit_logfile,'(a,i12)') ' Saving only selected link ID: ',inputdata_int_rl(id_rl_index,save_links(1:n_save_links)) write(unit_logfile,'(a,a24)') ' Saving only selected link name: ',inputdata_char_rl(roadname_rl_index,save_links(1:n_save_links)) elseif (use_only_special_links_flag.eq.2) then @@ -1100,19 +1103,6 @@ subroutine NORTRIP_multiroad_read_receptor_data endif endif - - ! if (use_only_special_links_flag.eq.2) then - ! !Save all the road links - ! write(unit_logfile,'(a,i)') ' Saving all road links: ',n_save_links - ! do i=1,n_roadlinks - ! save_links(i)=i - ! enddo - ! n_save_links=n_roadlinks - ! inputdata_int_rl(savedata_rl_index,save_links(1:n_save_links))=1 - ! endif - - - !inputdata_int_rl(roadindex_rl_index,save_links(1:n_save_links))=save_links(1:n_save_links) return 10 write(unit_logfile,'(2A)') 'ERROR reading road receptor link file: ',trim(filename_NORTRIP_receptors) diff --git a/NORTRIP_multiroad_read_metcoop_netcdf4.f90 b/NORTRIP_multiroad_read_metcoop_netcdf4.f90 index 9523789..d64453f 100644 --- a/NORTRIP_multiroad_read_metcoop_netcdf4.f90 +++ b/NORTRIP_multiroad_read_metcoop_netcdf4.f90 @@ -1,4 +1,4 @@ - subroutine NORTRIP_read_metcoop_netcdf4 +subroutine NORTRIP_read_metcoop_netcdf4 !Reads MEPS - METcoop 66 hour forecast data use NORTRIP_multiroad_index_definitions @@ -21,7 +21,7 @@ subroutine NORTRIP_read_metcoop_netcdf4 integer, allocatable :: dim_start_metcoop_nc(:) character(256) dimname_temp - integer i,j,k + integer :: i,j,k,t integer i_grid_mid,j_grid_mid real dlat_nc integer exists @@ -33,12 +33,12 @@ subroutine NORTRIP_read_metcoop_netcdf4 integer dim_id_nc_ensemble logical ensemble_dim_flag integer nDims - + double precision, allocatable :: var1d_nc_dp(:) double precision, allocatable :: var2d_nc_dp(:,:) - !double precision, allocatable :: var3d_nc_dp(:,:,:) - !double precision, allocatable :: var4d_nc_dp(:,:,:,:) real, allocatable :: var3d_emep(:,:,:) + real, allocatable :: var3d_nc_old(:,:,:,:) + real, allocatable :: var1d_nc_old(:,:) real, allocatable :: var4d_nc(:,:,:,:) real, allocatable :: var1d_nc_temp(:,:) @@ -47,6 +47,10 @@ subroutine NORTRIP_read_metcoop_netcdf4 double precision temp_date double precision date_to_number + + integer :: a_temp(num_date_index) !Temporary array used when filling date_nc array + integer meteo_nc_timesteps !The number of timesteps read from the meteo file + character(10) :: time !for printing date and time integer var_id_nc_projection real :: TOC=273.15 @@ -72,10 +76,12 @@ subroutine NORTRIP_read_metcoop_netcdf4 call date_to_datestr_bracket(start_date_input,pathname_nc_in,pathname_nc) pathfilename_nc=trim(pathname_nc)//trim(filename_nc) - + + found_file = .True. !To capture the case when the file exist on the first try. + !Test existence of the filename. If does not exist then use default - found_file=.true. inquire(file=trim(pathfilename_nc),exist=exists) + if (.not.exists) then write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf file does not exist: ', trim(pathfilename_nc) write(unit_logfile,'(A)') ' Will try every hour for the past 25 hours.' @@ -110,51 +116,51 @@ subroutine NORTRIP_read_metcoop_netcdf4 else write(unit_logfile,'(A,A)') ' Found earlier meteo netcdf file: ', trim(pathfilename_nc) endif - + else + write(*, *) "ERROR: Meteo file was found on first try. Need to use file from at least one hour back to get correct radiation data. Stopping." + stop endif - if (.not.found_file) then - pathfilename_nc=trim(pathname_nc)//trim(filename_alternative_nc) - write(unit_logfile,'(A,A)') ' Trying to find alternative meteo netcdf file does not exist: ', trim(pathfilename_nc) - - !Test existence of the filename. If does not exist then use default - inquire(file=trim(pathfilename_nc),exist=exists) - if (.not.exists) then - write(unit_logfile,'(A,A)') ' WARNING: Alternative meteo netcdf file does not exist: ', trim(pathfilename_nc) - write(unit_logfile,'(A)') ' Will try every hour for the past 25 hours.' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) + pathfilename_nc=trim(pathname_nc)//trim(filename_alternative_nc) + write(unit_logfile,'(A,A)') ' Trying to find alternative meteo netcdf file does not exist: ', trim(pathfilename_nc) - !Start search back 24 hours - new_start_date_input=start_date_input - found_file=.false. - do i=1,25 - !call incrtm(-24,new_start_date_input(1),new_start_date_input(2),new_start_date_input(3),new_start_date_input(4)) - temp_date=date_to_number(new_start_date_input,ref_year) - call number_to_date(temp_date-1./24.,new_start_date_input,ref_year) - !write(*,*) i,new_start_date_input(1:4) - call date_to_datestr_bracket(new_start_date_input,filename_alternative_nc_in,filename_alternative_nc) - call date_to_datestr_bracket(new_start_date_input,pathname_nc_in,pathname_nc) - pathfilename_nc=trim(pathname_nc)//trim(filename_alternative_nc) - write(unit_logfile,'(A,A)') ' Trying: ', trim(pathfilename_nc) - inquire(file=trim(pathfilename_nc),exist=exists) - if (exists) then - found_file=.true. - exit - else - found_file=.false. + !Test existence of the filename. If does not exist then use default + inquire(file=trim(pathfilename_nc),exist=exists) + if (.not.exists) then + write(unit_logfile,'(A,A)') ' WARNING: Alternative meteo netcdf file does not exist: ', trim(pathfilename_nc) + write(unit_logfile,'(A)') ' Will try every hour for the past 25 hours.' + + !Start search back 24 hours + new_start_date_input=start_date_input + found_file=.false. + do i=1,25 + !call incrtm(-24,new_start_date_input(1),new_start_date_input(2),new_start_date_input(3),new_start_date_input(4)) + temp_date=date_to_number(new_start_date_input,ref_year) + call number_to_date(temp_date-1./24.,new_start_date_input,ref_year) + !write(*,*) i,new_start_date_input(1:4) + call date_to_datestr_bracket(new_start_date_input,filename_alternative_nc_in,filename_alternative_nc) + call date_to_datestr_bracket(new_start_date_input,pathname_nc_in,pathname_nc) + pathfilename_nc=trim(pathname_nc)//trim(filename_alternative_nc) + write(unit_logfile,'(A,A)') ' Trying: ', trim(pathfilename_nc) + inquire(file=trim(pathfilename_nc),exist=exists) + if (exists) then + found_file=.true. + exit + else + found_file=.false. + endif + enddo + + if (.not.found_file) then + write(unit_logfile,'(A,A)') ' ERROR: Alternative meteo netcdf file still does not exist: ', trim(pathfilename_nc) + write(unit_logfile,'(A)') ' STOPPING' + !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) + stop 8 + else + write(unit_logfile,'(A,A)') ' Found earlier meteo netcdf file: ', trim(pathfilename_nc) endif - enddo - - if (.not.found_file) then - write(unit_logfile,'(A,A)') ' ERROR: Alternative meteo netcdf file still does not exist: ', trim(pathfilename_nc) - write(unit_logfile,'(A)') ' STOPPING' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) - stop 8 - else - write(unit_logfile,'(A,A)') ' Found earlier meteo netcdf file: ', trim(pathfilename_nc) + endif - - endif endif !Open the netcdf file for reading @@ -204,14 +210,12 @@ subroutine NORTRIP_read_metcoop_netcdf4 endif !Allocate the nc arrays for reading - allocate (var1d_time_nc(dim_length_nc(time_index)) )!x and y and time maximum dimmensions - allocate (var1d_nc(num_dims_nc,maxval(dim_length_nc))) !x and y and time maximum dimmensions + allocate (var1d_time_nc_old(dim_length_nc(time_index)) ) !Time allocated separately bc. it needs to be double presicion. + allocate (var1d_nc_old(num_dims_nc,maxval(dim_length_nc))) !x and y and time maximum dimmensions allocate (var1d_nc_dp(maxval(dim_length_nc))) !x and y and time maximum dimmensions - allocate (var3d_nc(num_var_nc,dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) + allocate (var3d_nc_old(num_var_nc,dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) allocate (var2d_nc(2,dim_length_nc(x_index),dim_length_nc(y_index))) !Lat and lon - !allocate (var3d_nc_dp(dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) allocate (var2d_nc_dp(dim_length_nc(x_index),dim_length_nc(y_index))) !Lat and lon - !allocate (var4d_nc_dp(dim_length_nc(x_index),dim_length_nc(y_index),1,dim_length_nc(time_index))) if (index(meteo_data_type,'emep').gt.0) then allocate (var3d_emep(dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) else @@ -223,36 +227,33 @@ subroutine NORTRIP_read_metcoop_netcdf4 !Read the x, y and time values do i=1,num_dims_nc status_nc = NF90_INQ_VARID (id_nc, trim(dim_name_nc(i)), var_id_nc(i)) - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var1d_nc(i,1:dim_length_nc(i)), start=(/dim_start_nc(i)/), count=(/dim_length_nc(i)/)) + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var1d_nc_old(i,1:dim_length_nc(i)), start=(/dim_start_nc(i)/), count=(/dim_length_nc(i)/)) + if (i.eq.time_index) then - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var1d_nc_dp(1:dim_length_nc(i)), start=(/dim_start_nc(i)/), count=(/dim_length_nc(i)/)) - !write(*,*) status_nc,dim_length_nc(i),trim(dim_name_nc(i)), var1d_nc_dp(1), var1d_nc_dp(dim_length_nc(i)) - - !This is only valid for 3 hourly EMEP data. Taken out - !if (index(meteo_data_type,'emep').gt.0) then - !Convert to seconds as this is given in days - ! var1d_nc_dp=var1d_nc_dp*3600.*24. - !endif + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var1d_nc_dp(1:dim_length_nc(i)), start=(/dim_start_nc(i)/), count=(/dim_length_nc(i)/)) - var1d_time_nc(:)=var1d_nc_dp(1:dim_length_nc(time_index)) + !This is only valid for 3 hourly EMEP data. Taken out + !if (index(meteo_data_type,'emep').gt.0) then + !Convert to seconds as this is given in days + ! var1d_nc_dp=var1d_nc_dp*3600.*24. + !endif + + var1d_time_nc_old(:)=var1d_nc_dp(1:dim_length_nc(time_index)) write(unit_logfile,'(3A,2i14)') ' ',trim(dim_name_nc(i)),' (min, max in hours): ' & - !,minval(int((var1d_nc(i,1:dim_length_nc(i))-var1d_nc(i,dim_start_nc(i)))/3600.+.5)+1) & - !,maxval(int((var1d_nc(i,1:dim_length_nc(i))-var1d_nc(i,dim_start_nc(i)))/3600.+.5)+1) - ,int((var1d_nc(i,1)-var1d_nc(i,1))/3600.+.5)+1 & - ,int((var1d_nc(i,dim_length_nc(i))-var1d_nc(i,1))/3600.+.5)+1 - !,int(var1d_nc(i,1)) & - !,int(var1d_nc(i,dim_length_nc(i))) + ,int((var1d_nc_old(i,1)-var1d_nc_old(i,1))/3600.+.5)+1 & + ,int((var1d_nc_old(i,dim_length_nc(i))-var1d_nc_old(i,1))/3600.+.5)+1 + else write(unit_logfile,'(3A,2f12.2)') ' ',trim(dim_name_nc(i)),' (min, max in km): ' & - ,minval(var1d_nc(i,1:dim_length_nc(i))),maxval(var1d_nc(i,1:dim_length_nc(i))) + ,minval(var1d_nc_old(i,1:dim_length_nc(i))),maxval(var1d_nc_old(i,1:dim_length_nc(i))) endif !Check the order of increasing size - if (var1d_nc(i,2).lt.var1d_nc(i,1)) then + if (var1d_nc_old(i,2).lt.var1d_nc_old(i,1)) then invert_dim_flag(i)=.true. else invert_dim_flag(i)=.false. endif - !write(*,*) 'Inversion flags (x,y) ',invert_dim_flag + enddo @@ -302,72 +303,72 @@ subroutine NORTRIP_read_metcoop_netcdf4 dim_start_metcoop_nc(4)=dim_start_nc(time_index) endif - + !Read through the variables in a loop do i=1,num_var_nc - !write(*,*) i,trim(var_name_nc(i)) + status_nc = NF90_INQ_VARID (id_nc, trim(var_name_nc(i)), var_id_nc(i)) - !write(*,*) 'Status1: ',status_nc,id_nc,var_id_nc(i),trim(var_name_nc(i)),NF_NOERR - !write(*,*) 'Status1: ',dim_start_metcoop_nc - !write(*,*) 'Status1: ',dim_length_metcoop_nc + if (status_nc.eq.NF90_NOERR) then - if (i.eq.lat_index.or.i.eq.lon_index) then - !write(*,*) i,lat_index,lon_index,dim_start_metcoop_nc(1:2), dim_length_metcoop_nc(1:2) - !status_nc = NF_GET_VARA_REAL (id_nc, var_id_nc(i), dim_start_metcoop_nc(1:2), dim_length_metcoop_nc(1:2), var2d_nc(i,:,:)) - !status_nc = NF_GET_VARA_DOUBLE (id_nc, var_id_nc(i), dim_start_nc(1:2), dim_length_nc(1:2), var2d_nc_dp);var2d_nc(i,:,:)=real(var2d_nc_dp) - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var2d_nc_dp,start=(/dim_start_metcoop_nc(1:2)/), count=(/dim_length_metcoop_nc(1:2)/));var2d_nc(i,:,:)=real(var2d_nc_dp) - - write(unit_logfile,'(A,i3,A,2A,2f16.4)') ' ',status_nc,' ',trim(var_name_nc(i)),' (min, max): ' & - ,minval(var2d_nc(i,:,:)),maxval(var2d_nc(i,:,:)) - else - !status_nc = NF_GET_VARA_REAL (id_nc, var_id_nc(i), dim_start_metcoop_nc, dim_length_metcoop_nc, var4d_nc);var3d_nc(i,:,:,:)=var4d_nc(:,:,1,:) - if (index(meteo_data_type,'emep').gt.0) then - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var3d_emep,start=(/dim_start_metcoop_nc/), count=(/dim_length_metcoop_nc/));var3d_nc(i,:,:,:)=var3d_emep(:,:,:) - !Read offsets and scaling - offset_nc=0. - scaling_nc=1. - status_nc1 =nf90_get_att(id_nc, var_id_nc(i), 'add_offset', offset_nc) - status_nc2 =nf90_get_att(id_nc, var_id_nc(i), 'scale_factor', scaling_nc) - !Only add offset and scale factor if available - if (status_nc1.eq.0.and.status_nc2.eq.0) then - var3d_nc(i,:,:,:)=var3d_nc(i,:,:,:)*scaling_nc+offset_nc + if (i.eq.lat_index.or.i.eq.lon_index) then + + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var2d_nc_dp,start=(/dim_start_metcoop_nc(1:2)/), count=(/dim_length_metcoop_nc(1:2)/)) + var2d_nc(i,:,:)=real(var2d_nc_dp) + + write(unit_logfile,'(A,i3,A,2A,2f16.4)') ' ',status_nc,' ',trim(var_name_nc(i)),' (min, max): ' & + ,minval(var2d_nc(i,:,:)),maxval(var2d_nc(i,:,:)) + else + + if (index(meteo_data_type,'emep').gt.0) then + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var3d_emep,start=(/dim_start_metcoop_nc/), count=(/dim_length_metcoop_nc/)) + var3d_nc_old(i,:,:,:)=var3d_emep(:,:,:) + !Read offsets and scaling + offset_nc=0. + scaling_nc=1. + status_nc1 =nf90_get_att(id_nc, var_id_nc(i), 'add_offset', offset_nc) + status_nc2 =nf90_get_att(id_nc, var_id_nc(i), 'scale_factor', scaling_nc) + !Only add offset and scale factor if available + if (status_nc1.eq.0.and.status_nc2.eq.0) then + var3d_nc_old(i,:,:,:)=var3d_nc(i,:,:,:)*scaling_nc+offset_nc + endif + + else + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var4d_nc,start=(/dim_start_metcoop_nc/), count=(/dim_length_metcoop_nc/)) + var3d_nc_old(i,:,:,:)=var4d_nc(:,:,1,:) + endif + + !Make appropriate changes, going backwards so as to overwrite the existing data + if (i.eq.precip_index.or.i.eq.precip_snow_index) then + do tt=dim_length_nc(time_index),2,-1 + var3d_nc_old(i,:,:,tt)=var3d_nc_old(i,:,:,tt)-var3d_nc_old(i,:,:,tt-1) + enddo + !Don't allow precip below the cutoff value + where (var3d_nc_old(i,:,:,:).lt.precip_cutoff) var3d_nc_old(i,:,:,:)=0. + endif + + if (i.eq.shortwaveradiation_index) then + do tt=dim_length_nc(time_index),2,-1 + var3d_nc_old(i,:,:,tt)=(var3d_nc_old(i,:,:,tt)-var3d_nc_old(i,:,:,tt-1))/3600. + enddo + endif + + if (i.eq.longwaveradiation_index) then + do tt=dim_length_nc(time_index),2,-1 + var3d_nc_old(i,:,:,tt)=(var3d_nc_old(i,:,:,tt)-var3d_nc_old(i,:,:,tt-1))/3600. + enddo endif - else - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var4d_nc,start=(/dim_start_metcoop_nc/), count=(/dim_length_metcoop_nc/));var3d_nc(i,:,:,:)=var4d_nc(:,:,1,:) - endif - - !Make appropriate changes, going backwards so as to overwrite the existing data - if (i.eq.precip_index.or.i.eq.precip_snow_index) then - do tt=dim_length_nc(time_index),2,-1 - !write(*,*) dim_length_nc(y_index),tt - var3d_nc(i,:,:,tt)=var3d_nc(i,:,:,tt)-var3d_nc(i,:,:,tt-1) - enddo - !Don't allow precip below the cutoff value - where (var3d_nc(i,:,:,:).lt.precip_cutoff) var3d_nc(i,:,:,:)=0. + if (i.eq.elevation_index) then + var3d_nc_old(i,:,:,:)=var3d_nc_old(i,:,:,:)/9.8 + endif + write(unit_logfile,'(A,i3,A,2A,2f16.2)') ' ',status_nc,' ',trim(var_name_nc(i)),' (min, max): ' & + ,minval(var3d_nc_old(i,:,:,:)),maxval(var3d_nc_old(i,:,:,:)) endif - if (i.eq.shortwaveradiation_index) then - do tt=dim_length_nc(time_index),2,-1 - var3d_nc(i,:,:,tt)=(var3d_nc(i,:,:,tt)-var3d_nc(i,:,:,tt-1))/3600. - enddo - endif - if (i.eq.longwaveradiation_index) then - do tt=dim_length_nc(time_index),2,-1 - var3d_nc(i,:,:,tt)=(var3d_nc(i,:,:,tt)-var3d_nc(i,:,:,tt-1))/3600. - enddo - endif - if (i.eq.elevation_index) then - var3d_nc(i,:,:,:)=var3d_nc(i,:,:,:)/9.8 - endif - - write(unit_logfile,'(A,i3,A,2A,2f16.2)') ' ',status_nc,' ',trim(var_name_nc(i)),' (min, max): ' & - ,minval(var3d_nc(i,:,:,:)),maxval(var3d_nc(i,:,:,:)) - endif - var_available_nc(i)=.true. + var_available_nc(i)=.true. else - write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc(i)) - var_available_nc(i)=.false. + write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc(i)) + var_available_nc(i)=.false. endif @@ -383,7 +384,7 @@ subroutine NORTRIP_read_metcoop_netcdf4 var1d_nc_temp=var1d_nc var2d_nc_temp=var2d_nc - var3d_nc_temp=var3d_nc + var3d_nc_temp=var3d_nc_old if (invert_dim_flag(x_index)) then write(unit_logfile,'(A)') ' Inverting X dimension' @@ -391,7 +392,7 @@ subroutine NORTRIP_read_metcoop_netcdf4 do i=1,dim_length_nc(x_index) var1d_nc(x_index,i)=var1d_nc_temp(x_index,dim_length_nc(x_index)+1-i) var2d_nc(:,i,:)=var2d_nc_temp(:,dim_length_nc(x_index)+1-i,:) - var3d_nc(:,i,:,:)=var3d_nc_temp(:,dim_length_nc(x_index)+1-i,:,:) + var3d_nc_old(:,i,:,:)=var3d_nc_temp(:,dim_length_nc(x_index)+1-i,:,:) enddo endif if (invert_dim_flag(y_index)) then @@ -399,7 +400,7 @@ subroutine NORTRIP_read_metcoop_netcdf4 do j=1,dim_length_nc(y_index) var1d_nc(y_index,j)=var1d_nc_temp(y_index,dim_length_nc(y_index)+1-j) var2d_nc(:,:,j)=var2d_nc_temp(:,:,dim_length_nc(y_index)+1-j) - var3d_nc(:,:,j,:)=var3d_nc_temp(:,:,dim_length_nc(y_index)+1-j,:) + var3d_nc_old(:,:,j,:)=var3d_nc_temp(:,:,dim_length_nc(y_index)+1-j,:) enddo endif @@ -412,60 +413,70 @@ subroutine NORTRIP_read_metcoop_netcdf4 !NOTE: round off errors in precipitation. Need to include a 0 minimum. status_nc = NF90_CLOSE (id_nc) - + !Put in some basic data checks to see if file is corrupt - if (abs(maxval(var3d_nc(temperature_index,:,:,:))).gt.500) then - write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc(temperature_index,:,:,:)) + if (abs(maxval(var3d_nc_old(temperature_index,:,:,:))).gt.500) then + write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc_old(temperature_index,:,:,:)) write(unit_logfile,'(A)') ' STOPPING' stop endif - if (abs(maxval(var3d_nc(x_wind_index,:,:,:))).gt.500) then - write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds x wind: ', maxval(var3d_nc(x_wind_index,:,:,:)) + if (abs(maxval(var3d_nc_old(x_wind_index,:,:,:))).gt.500) then + write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds x wind: ', maxval(var3d_nc_old(x_wind_index,:,:,:)) write(unit_logfile,'(A)') ' STOPPING' stop endif - if (abs(maxval(var3d_nc(shortwaveradiation_index,:,:,:))).gt.5000) then - write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds short wave radiation: ', maxval(var3d_nc(shortwaveradiation_index,:,:,:)) + if (abs(maxval(var3d_nc_old(shortwaveradiation_index,:,:,:))).gt.5000) then + write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds short wave radiation: ', maxval(var3d_nc_old(shortwaveradiation_index,:,:,:)) write(unit_logfile,'(A)') ' STOPPING' stop endif !Convert dew point to RH if RH not available and dewpoint is if (var_available_nc(dewpoint_index).and..not.var_available_nc(relhumidity_index)) then - do k=1,size(var3d_nc,4) - do j=1,size(var3d_nc,3) - do i=1,size(var3d_nc,2) - var3d_nc(relhumidity_index,i,j,k)=RH_from_dewpoint_func(var3d_nc(temperature_index,i,j,k)-TOC,var3d_nc(dewpoint_index,i,j,k)-TOC)/100. - var3d_nc(relhumidity_index,i,j,k)=max(var3d_nc(relhumidity_index,i,j,k),0.) - var3d_nc(relhumidity_index,i,j,k)=min(var3d_nc(relhumidity_index,i,j,k),1.) - enddo - enddo + do k=1,size(var3d_nc_old,4) + do j=1,size(var3d_nc_old,3) + do i=1,size(var3d_nc_old,2) + var3d_nc_old(relhumidity_index,i,j,k)=RH_from_dewpoint_func(var3d_nc_old(temperature_index,i,j,k)-TOC,var3d_nc_old(dewpoint_index,i,j,k)-TOC)/100. + var3d_nc_old(relhumidity_index,i,j,k)=max(var3d_nc_old(relhumidity_index,i,j,k),0.) + var3d_nc_old(relhumidity_index,i,j,k)=min(var3d_nc_old(relhumidity_index,i,j,k),1.) + enddo + enddo enddo endif - !In the case of lat lon coordinates in deimmensions then populate the lat lon 2d field as this is used further + !In the case of lat lon coordinates in dimensions then populate the lat lon 2d field as this is used further if (meteo_nc_projection_type.ne.LL_projection_index) then do j=1,size(var2d_nc,3) - do i=1,size(var2d_nc,2) - var2d_nc(lon_index,i,j)=var1d_nc(x_index,i) - var2d_nc(lat_index,i,j)=var1d_nc(y_index,j) + do i=1,size(var2d_nc,2) + var2d_nc(lon_index,i,j)=var1d_nc_old(x_index,i) + var2d_nc(lat_index,i,j)=var1d_nc_old(y_index,j) + enddo enddo + endif + + !In the case of lat lon coordinates in dimensions then populate the lat lon 2d field as this is used further + if (meteo_nc_projection_type.ne.LL_projection_index) then + do j=1,size(var2d_nc,3) + do i=1,size(var2d_nc,2) + var2d_nc(lon_index,i,j)=var1d_nc_old(x_index,i) + var2d_nc(lat_index,i,j)=var1d_nc_old(y_index,j) + enddo enddo endif !Calculate angle difference between North and the Model Y direction based on the middle grids - !Not correct, needs to be fixed + !Not correct, needs to be fixed !TODO: Is this fixed? i_grid_mid=int(dim_length_nc(x_index)/2) j_grid_mid=int(dim_length_nc(y_index)/2) - dgrid_nc(x_index)=var1d_nc(x_index,i_grid_mid)-var1d_nc(x_index,i_grid_mid-1) - dgrid_nc(y_index)=var1d_nc(y_index,j_grid_mid)-var1d_nc(y_index,j_grid_mid-1) + dgrid_nc(x_index)=var1d_nc_old(x_index,i_grid_mid)-var1d_nc_old(x_index,i_grid_mid-1) + dgrid_nc(y_index)=var1d_nc_old(y_index,j_grid_mid)-var1d_nc_old(y_index,j_grid_mid-1) dlat_nc=var2d_nc(lat_index,i_grid_mid,j_grid_mid)-var2d_nc(lat_index,i_grid_mid,j_grid_mid-1) !If the coordinates are in km instead of metres then change to metres (assuming the difference is not going to be > 100 km if (dgrid_nc(x_index).lt.100.and.meteo_nc_projection_type.ne.LL_projection_index) then dgrid_nc=dgrid_nc*1000. - var1d_nc(x_index,:)=var1d_nc(x_index,:)*1000. - var1d_nc(y_index,:)=var1d_nc(y_index,:)*1000. + var1d_nc_old(x_index,:)=var1d_nc_old(x_index,:)*1000. + var1d_nc_old(y_index,:)=var1d_nc_old(y_index,:)*1000. endif !This doesn't seem to make sense. Check this again @@ -473,17 +484,67 @@ subroutine NORTRIP_read_metcoop_netcdf4 write(unit_logfile,'(A,2f12.3)') ' Grid spacing X and Y (m): ', dgrid_nc(x_index),dgrid_nc(y_index) write(unit_logfile,'(A,2i,f12.4)') ' Angle difference between grid and geo North (i,j,deg): ', i_grid_mid,j_grid_mid,angle_nc + + + meteo_nc_timesteps = nint(1 + (dim_length_nc(time_index)-1)/timestep) !Number of time steps that will be saved from the meteo file. (If timestep = 1h this will just be the number of hours) + + !Fill a date_nc array that is used to match meteo dates to the date range specified in the simulation call. + allocate(date_nc(num_date_index,meteo_nc_timesteps)) + + call number_to_date(dble(int(var1d_nc_old(time_index,1)/sngl(seconds_in_hour*hours_in_day)+1./24./60.)),date_nc(:,1),ref_year) + + date_nc(hour_index,1)=int((var1d_nc_old(time_index,1)-(dble(int(var1d_nc_old(time_index,1)/sngl(seconds_in_hour*hours_in_day)+1./24./60.)))*sngl(seconds_in_hour*hours_in_day))/3600.+.5) + do t=1, meteo_nc_timesteps-1 + a_temp=date_nc(:,1) + call minute_increment(int(minutes_in_hour*timestep)*t,a_temp(1),a_temp(2),a_temp(3),a_temp(4),a_temp(5)) + date_nc(:,t+1)=a_temp + enddo + + !Check if timestep is != 1; if true, allocate new, larger arrays and interpolate the hourly values into the new arrays. + if ( timestep .ne. 1) then + + !Allocate an array with the new time_index. + if (allocated(var3d_nc)) deallocate(var3d_nc) + allocate (var3d_nc(num_var_nc,dim_length_nc(x_index),dim_length_nc(y_index),nint(1 + (dim_length_nc(time_index)-1)/timestep))) + allocate (var1d_nc(num_dims_nc,maxval(dim_length_nc))) + allocate (var1d_time_nc(nint(1 + (dim_length_nc(time_index)-1)/timestep))) + + call date_and_time(TIME=time) + print*, "loop start: ", time + do i = int(1/timestep), nint(dim_length_nc(time_index)/timestep) + + var3d_nc(:,:,:,i-int(1/timestep)+1) = var3d_nc_old(:,:,:,floor(i*timestep)) + ( var3d_nc_old(:,:,:,min(floor(i*timestep)+1,size(var3d_nc_old,dim=4))) - var3d_nc_old(:,:,:,floor(i*timestep)) ) * (i*timestep-floor(i*timestep)) !/1 + + var3d_nc(precip_index,:,:,i-int(1/timestep)+1) = max(0.,var3d_nc_old(precip_index,:,:,min(floor(i*timestep)+1,size(var3d_nc_old,dim=4)))/6) + var3d_nc(precip_snow_index,:,:,i-int(1/timestep)+1) = max(0.,var3d_nc_old(precip_snow_index,:,:,min(floor(i*timestep)+1,size(var3d_nc_old,dim=4)))/6) + + var1d_time_nc(i-int(1/timestep)+1) = var1d_time_nc_old(floor(i*timestep)) + ( var1d_time_nc_old(min(floor(i*timestep)+1,size(var1d_time_nc_old))) - var1d_time_nc_old(floor(i*timestep)) ) * (i*timestep-floor(i*timestep)) !/1 + + end do + call date_and_time(TIME = time) + print*, "end loop: ", time + + + var1d_nc(x_index,:) = var1d_nc_old(x_index,:) + var1d_nc(y_index,:) = var1d_nc_old(y_index,:) + + else + var1d_nc = var1d_nc_old + var1d_time_nc = var1d_time_nc_old + var3d_nc = var3d_nc_old + end if + !Set the array dimensions to the available ones. Can be changed later based on input information, particularly for time - end_dim_nc=dim_length_nc start_dim_nc=dim_start_nc - - if (allocated(var4d_nc)) deallocate(var4d_nc) - if (allocated(var3d_emep)) deallocate(var3d_emep) + end_dim_nc=dim_length_nc + end_dim_nc(time_index) = size(var3d_nc,dim=4) + if (allocated(var3d_nc_old)) deallocate(var3d_nc_old) + if (allocated(var1d_nc_old)) deallocate(var1d_nc_old) if (allocated(var1d_nc_dp)) deallocate(var1d_nc_dp) if (allocated(var2d_nc_dp)) deallocate(var2d_nc_dp) - if (allocated(dim_length_metcoop_nc)) deallocate(dim_length_metcoop_nc) - if (allocated(dim_start_metcoop_nc)) deallocate(dim_start_metcoop_nc) - - end subroutine NORTRIP_read_metcoop_netcdf4 + if (allocated(var4d_nc)) deallocate(var4d_nc) + if (allocated(var3d_emep)) deallocate(var3d_emep) - + + +end subroutine NORTRIP_read_metcoop_netcdf4 \ No newline at end of file diff --git a/NORTRIP_multiroad_read_meteo_netcdf4.f90 b/NORTRIP_multiroad_read_meteo_netcdf4.f90 deleted file mode 100644 index cddb120..0000000 --- a/NORTRIP_multiroad_read_meteo_netcdf4.f90 +++ /dev/null @@ -1,347 +0,0 @@ - subroutine NORTRIP_read_meteo_NBV_netcdf4 - !Reads in meteo from special files made in the NBV project. - !Does not include the disaggregation of precip and fluxes - - use NORTRIP_multiroad_index_definitions - !Update to netcdf 4 and 64 bit in this version 2 of NORTRIP_read_meteo_netcdf - use netcdf - - implicit none - - !include 'netcdf.inc' - - !Local variables - integer status_nc,status_type_nc !Error message - integer id_nc - integer dim_id_nc(num_dims_nc) - integer xtype_nc(num_var_nc) - integer natts_nc(num_var_nc) - integer var_id_nc(num_var_nc) - - character(256) dimname_temp - integer i,j - integer i_grid_mid,j_grid_mid - real dlat_nc - integer exists - integer new_start_date_input(num_date_index) - logical found_file - character(256) pathname_nc_in,filename_nc_in,filename_alternative_nc_in - - double precision, allocatable :: var1d_nc_dp(:) - double precision, allocatable :: var2d_nc_dp(:,:) - double precision, allocatable :: var3d_nc_dp(:,:,:) - real, allocatable :: var2d_nc_re(:,:) - real, allocatable :: var3d_nc_re(:,:,:) - real, allocatable :: var1d_nc_temp(:,:) - real, allocatable :: var2d_nc_temp(:,:,:) - real, allocatable :: var3d_nc_temp(:,:,:,:) - - double precision temp_date - double precision date_to_number - - integer var_id_nc_projection - - logical invert_dim_flag(num_dims_nc) - - write(unit_logfile,'(A)') '================================================================' - write(unit_logfile,'(A)') 'Reading meteorological data (NORTRIP_read_meteo_netcdf v2)' - write(unit_logfile,'(A)') '================================================================' - - invert_dim_flag=.false. - - !pathname_nc='C:\BEDRE BYLUFT\NORTRIP implementation\test\'; - !filename_nc='AROME_1KM_OSLO_20141028_EPI.nc' - pathname_nc_in=pathname_nc - filename_nc_in=filename_nc_template - filename_alternative_nc_in=filename_alternative_nc_template - call date_to_datestr_bracket(start_date_input,filename_nc_in,filename_nc) - call date_to_datestr_bracket(start_date_input,filename_alternative_nc_in,filename_alternative_nc) - call date_to_datestr_bracket(start_date_input,pathname_nc_in,pathname_nc) - - pathfilename_nc=trim(pathname_nc)//trim(filename_nc) - - !Test existence of the filename. If does not exist then try alternative - inquire(file=trim(pathfilename_nc),exist=exists) - if (.not.exists) then - write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf file does not exist: ', trim(pathfilename_nc) - write(unit_logfile,'(A)') ' Will try 24 hours before.' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) - - !Start search back 24 hours - new_start_date_input=start_date_input - found_file=.false. - do i=1,1 - !call incrtm(-24,new_start_date_input(1),new_start_date_input(2),new_start_date_input(3),new_start_date_input(4)) - temp_date=date_to_number(new_start_date_input,ref_year) - call number_to_date(temp_date-1.,new_start_date_input) - !write(*,*) i,new_start_date_input(1:4) - call date_to_datestr_bracket(new_start_date_input,filename_nc_in,filename_nc) - call date_to_datestr_bracket(new_start_date_input,pathname_nc_in,pathname_nc) - pathfilename_nc=trim(pathname_nc)//trim(filename_nc) - write(unit_logfile,'(A,A)') ' Trying: ', trim(pathfilename_nc) - inquire(file=trim(pathfilename_nc),exist=exists) - if (exists) then - found_file=.true. - exit - else - found_file=.false. - endif - enddo - - if (.not.found_file) then - !write(unit_logfile,'(A,A)') ' ERROR: Meteo netcdf file still does not exist: ', trim(pathfilename_nc) - write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf file still does not exist: ', trim(pathfilename_nc) - !write(unit_logfile,'(A)') ' STOPPING' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) - !stop 8 - else - write(unit_logfile,'(A,A)') ' Found earlier meteo netcdf file: ', trim(pathfilename_nc) - endif - - endif - - if (.not.found_file) then - write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf file does not exist. Trying alternative file name ', trim(pathfilename_nc) - pathfilename_nc=trim(pathname_nc)//trim(filename_alternative_nc) - - !Test existence of the filename. If does not exist then try alternative - inquire(file=trim(pathfilename_nc),exist=exists) - if (.not.exists) then - write(unit_logfile,'(A,A)') ' WARNING: Alternative meteo netcdf file does not exist: ', trim(pathfilename_nc) - write(unit_logfile,'(A)') ' Will try 24 hours before.' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) - - !Start search back 24 hours - new_start_date_input=start_date_input - found_file=.false. - do i=1,1 - !call incrtm(-24,new_start_date_input(1),new_start_date_input(2),new_start_date_input(3),new_start_date_input(4)) - temp_date=date_to_number(new_start_date_input,ref_year) - call number_to_date(temp_date-1.,new_start_date_input) - !write(*,*) i,new_start_date_input(1:4) - call date_to_datestr_bracket(start_date_input,filename_alternative_nc_in,filename_alternative_nc) - call date_to_datestr_bracket(new_start_date_input,pathname_nc_in,pathname_nc) - pathfilename_nc=trim(pathname_nc)//trim(filename_alternative_nc) - write(unit_logfile,'(A,A)') ' Trying: ', trim(pathfilename_nc) - inquire(file=trim(pathfilename_nc),exist=exists) - if (exists) then - found_file=.true. - exit - else - found_file=.false. - endif - enddo - - if (.not.found_file) then - write(unit_logfile,'(A,A)') ' ERROR: Meteo netcdf file still does not exist: ', trim(pathfilename_nc) - write(unit_logfile,'(A)') ' STOPPING' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) - stop 8 - else - write(unit_logfile,'(A,A)') ' Found earlier meteo netcdf file: ', trim(pathfilename_nc) - endif - - endif - - endif - - !Open the netcdf file for reading - write(unit_logfile,'(2A)') ' Opening netcdf meteo file: ',trim(pathfilename_nc) - !status_nc = NF_OPEN (pathfilename_nc, NF_NOWRITE, id_nc) - status_nc = NF90_OPEN (pathfilename_nc, nf90_nowrite, id_nc) - !if (status_nc .NE. NF_NOERR) write(unit_logfile,'(A,I)') 'ERROR opening netcdf file: ',status_nc - if (status_nc .NE. NF90_NOERR) write(unit_logfile,'(A,I)') 'ERROR opening netcdf file: ',status_nc - - !Find the projection. If no projection then in lat lon coordinates - status_nc = NF90_INQ_VARID (id_nc,trim(projection_name_nc),var_id_nc_projection) - - if (status_nc.eq.NF90_NOERR) then - !If there is a projection then read in the attributes. All these are doubles - !status_nc = nf90_inquire_variable(id_nc, var_id_nc_projection, natts = numAtts_projection) - status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'standard_parallel', meteo_nc_projection_attributes(1:2)) - status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'longitude_of_central_meridian', meteo_nc_projection_attributes(3)) - status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'latitude_of_projection_origin', meteo_nc_projection_attributes(4)) - status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'earth_radius', meteo_nc_projection_attributes(5)) - meteo_nc_projection_type=LCC_projection_index - - write(unit_logfile,'(A,5f12.2)') 'Reading lambert_conformal_conic projection. ',meteo_nc_projection_attributes(1:5) - else - meteo_nc_projection_type=LL_projection_index - endif - - !Find out the x,y and time dimmensions of the file by looking at pressure variable - status_nc = NF90_INQ_DIMID (id_nc,dim_name_nc(x_index),dim_id_nc(x_index)) - status_nc = NF90_INQUIRE_DIMENSION (id_nc,dim_id_nc(x_index),dimname_temp,dim_length_nc(x_index)) - status_nc = NF90_INQ_DIMID (id_nc,dim_name_nc(y_index),dim_id_nc(y_index)) - status_nc = NF90_INQUIRE_DIMENSION (id_nc,dim_id_nc(y_index),dimname_temp,dim_length_nc(y_index)) - status_nc = NF90_INQ_DIMID (id_nc,dim_name_nc(time_index),dim_id_nc(time_index)) - status_nc = NF90_INQUIRE_DIMENSION (id_nc,dim_id_nc(time_index),dimname_temp,dim_length_nc(time_index)) - write(unit_logfile,'(A,3I)') ' Size of dimensions (x,y,t): ',dim_length_nc - - !Allocate the nc arrays for reading - allocate (var1d_time_nc(dim_length_nc(time_index)) )!x and y and time maximum dimmensions - allocate (var1d_nc(num_dims_nc,maxval(dim_length_nc))) !x and y and time maximum dimmensions - allocate (var1d_nc_dp(maxval(dim_length_nc))) !x and y and time maximum dimmensions - allocate (var3d_nc(num_var_nc,dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) - allocate (var2d_nc(2,dim_length_nc(x_index),dim_length_nc(y_index))) !Lat and lon - allocate (var3d_nc_dp(dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) - allocate (var2d_nc_dp(dim_length_nc(x_index),dim_length_nc(y_index))) !Lat and lon - allocate (var2d_nc_re(dim_length_nc(x_index),dim_length_nc(y_index))) !Lat and lon - allocate (var3d_nc_re(dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) - - !Set the number of hours to be read - - !Read the x, y and time values - do i=1,num_dims_nc - status_nc = NF90_INQ_VARID (id_nc, trim(dim_name_nc(i)), var_id_nc(i)) - !status_nc = NF_GET_VARA_REAL (id_nc, var_id_nc(i), dim_start_nc(i), dim_length_nc(i), var1d_nc(i,:)) - !status_nc = NF90_GET_VAR (id_nc, var_id_nc(i),var1d_nc(i,1:dim_length_nc(i)),start=(/dim_start_nc(i)/),count=(/dim_length_nc(i)/))!;var1d_nc(1:dim_length_nc(i),i)=real(var1d_nc_dp(1:dim_length_nc(i))) - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i),var1d_nc_dp(1:dim_length_nc(i)),start=(/dim_start_nc(i)/),count=(/dim_length_nc(i)/));var1d_nc(i,1:dim_length_nc(i))=real(var1d_nc_dp(1:dim_length_nc(i))) - if (i.eq.time_index) then - var1d_time_nc(:)=var1d_nc_dp(1:dim_length_nc(time_index)) - write(unit_logfile,'(3A,2i12)') ' ',trim(dim_name_nc(i)),' (min, max in hours): ' & - ,minval(int((var1d_nc(i,1:dim_length_nc(i))-var1d_nc(i,dim_start_nc(i)))/3600.+.5)+1) & - ,maxval(int((var1d_nc(i,1:dim_length_nc(i))-var1d_nc(i,dim_start_nc(i)))/3600.+.5)+1) - else - write(unit_logfile,'(3A,2f12.2)') ' ',trim(dim_name_nc(i)),' (min, max in km): ' & - ,minval(var1d_nc(i,1:dim_length_nc(i))/1000.),maxval(var1d_nc(i,1:dim_length_nc(i))/1000.) - endif - - !Check the order of increasing size - if (var1d_nc(i,2).lt.var1d_nc(i,1)) then - invert_dim_flag(i)=.true. - else - invert_dim_flag(i)=.false. - endif - - enddo - - !Read through the variables in a loop - do i=1,num_var_nc - !write(*,*) i,trim(var_name_nc(i)) - status_nc = NF90_INQ_VARID (id_nc, trim(var_name_nc(i)), var_id_nc(i)) - !write(*,*) 'Status1: ',status_nc,var_id_nc(i),trim(var_name_nc(i)) - !write(*,*) 'Status1: ',dim_start_nc - !write(*,*) 'Status1: ',dim_length_nc - if (status_nc.ge.0) then - status_type_nc = nf90_inquire_variable(id_nc, var_id_nc(i), xtype=xtype_nc(i)) - if (i.eq.lat_index.or.i.eq.lon_index) then - !write(*,*) trim(var_name_nc(i)),xtype_nc(i), trim(meteo_data_type) - if (xtype_nc(i).eq.NF90_DOUBLE) then - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var2d_nc_dp, start=(/dim_start_nc(1:2)/), count=(/dim_length_nc(1:2)/));var2d_nc(i,:,:)=real(var2d_nc_dp) - else - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var2d_nc_re, start=(/dim_start_nc(1:2)/), count=(/dim_length_nc(1:2)/));var2d_nc(i,:,:)=var2d_nc_re - endif - write(unit_logfile,'(3A,2f16.4)') ' ',trim(var_name_nc(i)),' (min, max): ',minval(var2d_nc(i,:,:)),maxval(var2d_nc(i,:,:)) - else - !write(*,*) trim(var_name_nc(i)),xtype_nc(i), trim(meteo_data_type) - if (xtype_nc(i).eq.NF90_DOUBLE) then - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var3d_nc_dp, start=(/dim_start_nc/), count=(/dim_length_nc/));var3d_nc(i,:,:,:)=real(var3d_nc_dp) - else - status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var3d_nc_re, start=(/dim_start_nc/), count=(/dim_length_nc/));var3d_nc(i,:,:,:)=var3d_nc_re - endif - write(unit_logfile,'(3A,2f16.2)') ' ',trim(var_name_nc(i)),' (min, max): ',minval(var3d_nc(i,:,:,:)),maxval(var3d_nc(i,:,:,:)) - endif - var_available_nc(i)=.true. - else - write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc(i)) - var_available_nc(i)=.false. - endif - - - enddo - - !Invert dimmension if required - if (invert_dim_flag(x_index).or.invert_dim_flag(y_index)) then - allocate (var1d_nc_temp(num_dims_nc,maxval(dim_length_nc))) - allocate (var2d_nc_temp(2,dim_length_nc(x_index),dim_length_nc(y_index))) - allocate (var3d_nc_temp(num_var_nc,dim_length_nc(x_index),dim_length_nc(y_index),dim_length_nc(time_index))) - - var1d_nc_temp=var1d_nc - var2d_nc_temp=var2d_nc - var3d_nc_temp=var3d_nc - - if (invert_dim_flag(x_index)) then - write(unit_logfile,'(A)') ' Inverting X dimmension' - - do i=1,dim_length_nc(x_index) - var1d_nc(:,i)=var1d_nc_temp(:,dim_length_nc(x_index)+1-i) - var2d_nc(:,i,:)=var2d_nc_temp(:,dim_length_nc(x_index)+1-i,:) - var3d_nc(:,i,:,:)=var3d_nc_temp(:,dim_length_nc(x_index)+1-i,:,:) - enddo - endif - if (invert_dim_flag(y_index)) then - write(unit_logfile,'(A)') ' Inverting Y dimmension' - do j=1,dim_length_nc(y_index) - var1d_nc(:,j)=var1d_nc_temp(:,dim_length_nc(y_index)+1-j) - var2d_nc(:,:,j)=var2d_nc_temp(:,:,dim_length_nc(y_index)+1-j) - var3d_nc(:,:,j,:)=var3d_nc_temp(:,:,dim_length_nc(y_index)+1-j,:) - enddo - endif - - deallocate (var1d_nc_temp) - deallocate (var2d_nc_temp) - deallocate (var3d_nc_temp) - - endif - - !NOTE: round off errors in precipitation. Need to include a 0 minimum. - do i=1,num_var_nc - if (i.eq.precip_index.or.i.eq.precip_snow_index) then - where (var3d_nc(i,:,:,:).lt.precip_cutoff) var3d_nc(i,:,:,:)=0. - endif - enddo - - - status_nc = NF90_CLOSE (id_nc) - - !Put in some basic data checks to see if file is corrupt - if (abs(maxval(var3d_nc(temperature_index,:,:,:))).gt.500) then - write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc(temperature_index,:,:,:)) - write(unit_logfile,'(A)') ' STOPPING' - stop - endif - if (abs(maxval(var3d_nc(x_wind_index,:,:,:))).gt.500) then - write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds x wind: ', maxval(var3d_nc(x_wind_index,:,:,:)) - write(unit_logfile,'(A)') ' STOPPING' - stop - endif - if (abs(maxval(var3d_nc(shortwaveradiation_index,:,:,:))).gt.5000) then - write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds short wave radiation: ', maxval(var3d_nc(shortwaveradiation_index,:,:,:)) - write(unit_logfile,'(A)') ' STOPPING' - stop - endif - - !Calculate angle difference between North and the Model Y direction based on the middle grids - !Not correct but it might be now - i_grid_mid=int(dim_length_nc(x_index)/2) - j_grid_mid=int(dim_length_nc(y_index)/2) - dgrid_nc(x_index)=(var1d_nc(x_index,i_grid_mid)-var1d_nc(x_index,i_grid_mid-1)) - dgrid_nc(y_index)=(var1d_nc(y_index,j_grid_mid)-var1d_nc(y_index,j_grid_mid-1)) - dlat_nc=var2d_nc(lat_index,i_grid_mid,j_grid_mid)-var2d_nc(lat_index,i_grid_mid,j_grid_mid-1) - - !If the coordinates are in km instead of metres then change to metres (assuming the difference is not going to be > 100 km - if (dgrid_nc(x_index).lt.100.and.meteo_nc_projection_type.ne.LL_projection_index) then - dgrid_nc=dgrid_nc*1000. - var1d_nc(x_index,:)=var1d_nc(x_index,:)*1000. - var1d_nc(y_index,:)=var1d_nc(y_index,:)*1000. - endif - - !This doesn't seem to make sense. Check this again - angle_nc=180./3.14159*acos(dlat_nc*3.14159/180.*6.37e6/dgrid_nc(y_index)) - write(unit_logfile,'(A,2f12.3)') ' Grid spacing X and Y (m): ', dgrid_nc(x_index),dgrid_nc(y_index) - write(unit_logfile,'(A,2i,f12.4)') ' Angle difference between grid and geo North (i,j,deg): ', i_grid_mid,j_grid_mid,angle_nc - - !Set the array dimensions to the available ones. Can be changed later based on input information, particularly for time - end_dim_nc=dim_length_nc - start_dim_nc=dim_start_nc - - deallocate (var3d_nc_re) - deallocate (var2d_nc_re) - deallocate (var3d_nc_dp) - deallocate (var2d_nc_dp) - deallocate (var1d_nc_dp) - - - end subroutine NORTRIP_read_meteo_NBV_netcdf4 - diff --git a/NORTRIP_multiroad_read_meteo_obs_data.f90 b/NORTRIP_multiroad_read_meteo_obs_data.f90 index 2e54a1e..73053e8 100644 --- a/NORTRIP_multiroad_read_meteo_obs_data.f90 +++ b/NORTRIP_multiroad_read_meteo_obs_data.f90 @@ -1,4 +1,4 @@ - subroutine NORTRIP_multiroad_read_meteo_obs_data +subroutine NORTRIP_multiroad_read_meteo_obs_data use NORTRIP_multiroad_index_definitions @@ -12,7 +12,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data character(256) temp_str,temp_str1,temp_str2 character(256) temp_str_array(30) character(64) header_str(30),read_str(30),match_str - integer index_val,index_val1,index_val2,index_val3 + integer index_val,index_val1,index_val2,index_val3 !TODO: Hva er 1, 2, 3? integer i_head integer unit_in integer ro,k,jj,ii,ro2,t,j @@ -73,7 +73,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data !This file is a fixed format approximately as it comes out of KDVH but with names as single strings !Only accounts for height, not positional differences as these are given in lat lon - n_meteo_obs_stations=8 + n_meteo_obs_stations=8 !TODO: Why is this set to 8? !Find out how long the file is, reading a dummy variable @@ -140,7 +140,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data enddo write(unit_logfile,*) 'Number of stations in ; seperated file = ',index_val n_meteo_obs_stations=i - + else write(unit_logfile,'(a10,a24,a10,a10,a10)') 'ID','Name','Height','Lat','Lon' @@ -257,8 +257,8 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data meteo_obs_inputdata_available=0 n_meteo_obs_date=0 do i=1,n_meteo_obs_stations - n_meteo_obs_date_counter(i)=0 - do j=1,index_val + n_meteo_obs_date_counter(i)=0 + do j=1,index_val if (station_id_temp(j).eq.meteo_obs_ID(i)) then meteo_obs_inputdata_available(i)=1 n_meteo_obs_date_counter(i)=n_meteo_obs_date_counter(i)+1 !Sets the number of dates based on the last id read @@ -268,19 +268,10 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data n_meteo_obs_station_data=sum(meteo_obs_inputdata_available) n_meteo_obs_date=maxval(n_meteo_obs_date_counter) !Uses the maximum value which should be correct - !Read data - !Must match the metadata file in number of stations - ! if (n_meteo_obs_station_data.ne.0) then - ! n_meteo_obs_date=int(index_val/n_meteo_obs_station_data+.5) - !else - ! n_meteo_obs_date=0 - !endif - write(unit_logfile,*) 'Number of stations= ',n_meteo_obs_stations write(unit_logfile,*) 'Number of stations in file= ',n_meteo_obs_station_data write(unit_logfile,*) 'Number of dates= ',n_meteo_obs_date - !allocate (input_array(i_head,index_val)) allocate (input_array(i_head,n_meteo_obs_date,n_meteo_obs_stations)) input_array=missing_data @@ -297,7 +288,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data index_val=index_val+1 read(unit_in,*,end=8) read_str(1:i_head) !write(*,*) read_str - do ii=1,i_head + do ii=1,i_head !Set these two string types to missing data for the old obs datasets index_val3=index(read_str(ii),'x') index_val1=index(read_str(ii),'-') @@ -307,158 +298,122 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data else read(read_str(ii),*) input_array_line(ii,index_val) endif - enddo + enddo enddo 8 allocate (counter_id(n_meteo_obs_stations)) counter_id=0 input_array=missing_data do i=1,n_meteo_obs_stations - do j=1,index_val + do j=1,index_val if (station_id_temp(j).eq.meteo_obs_ID(i)) then counter_id(i)=counter_id(i)+1 input_array(:,counter_id(i),i)=input_array_line(:,j) - !write(*,*) input_array(:,counter_id(i),i) endif enddo enddo - - !read(unit_in,*) (((input_array(ii,jj,ro),ii=1,i_head),jj=1,n_meteo_obs_date),ro=1,n_meteo_obs_stations) - ! do ro=1,n_meteo_obs_stations - ! !Only read if data is available. This method means that the order must be the same in the metadata file and the data files - ! if (meteo_obs_inputdata_available(ro).eq.1) then - ! do jj=1,n_meteo_obs_date - ! read(unit_in,*) read_str(1:i_head) - ! !write(*,'(a10)') read_str(1:i_head) - ! do ii=1,i_head - ! !Set these two string types to missing data when they appear alone - ! index_val1=index(read_str(ii),'-') - ! index_val2=index(read_str(ii),'.') - ! if (index_val1.eq.len(trim(read_str(ii))).or.index_val2.eq.len(trim(read_str(ii)))) then - ! input_array(ii,jj,ro)=missing_data - ! else - ! read(read_str(ii),*) input_array(ii,jj,ro) - ! endif - ! enddo - ! !write(*,'(f10.2)') input_array(:,jj,ro) - ! enddo - ! else - ! !Fill the array with missing data - ! do jj=1,n_meteo_obs_date - ! do ii=1,i_head - ! input_array(ii,jj,ro)=missing_data - ! enddo - ! enddo - ! endif - ! - ! enddo - - + 10 close(unit_in,status='keep') - else - - do ro=1,n_read_obs_files + else + do ro=1,n_read_obs_files + + !Open the obs file for reading + unit_in=40 - !Open the obs file for reading - unit_in=40 - - temp_str='station_str' - write(temp_str2,'(i0)') meteo_obs_ID(ro) - filename_temp=trim(inpath_meteo_obs_data)//trim(infile_meteo_obs_data) - filename_temp=replace_string_char(trim(temp_str2),trim(temp_str),filename_temp) + temp_str='station_str' + write(temp_str2,'(i0)') meteo_obs_ID(ro) + filename_temp=trim(inpath_meteo_obs_data)//trim(infile_meteo_obs_data) + filename_temp=replace_string_char(trim(temp_str2),trim(temp_str),filename_temp) - inquire(file=trim(filename_temp),exist=exists) - if (.not.exists) then - write(unit_logfile,'(A,A)') ' WARNING: Meteo obs data file does not exist: ', trim(filename_temp) - goto 12 - else - write(unit_logfile,'(2A)') ' Opening obs meteo file: ',trim(filename_temp) - endif - open(unit_in,file=filename_temp,access='sequential',status='old',readonly) - - !rewind(unit_in) - - !Read in header - !Stnr Year Month Day Time(NMT) UU PO TA RR_1 FF DD QSI NN TV - - !Read header string and split at spaces. Assumes single space seperation - temp_str1='' - temp_str2='Not available' - index_val=1 - i_head=0 - read(unit_in,'(a)',end=11) temp_str !Read the header string - !Check if any data given the ndap format for no data - !write(*,*) temp_str - if (index(temp_str,'****').gt.0) then - input_array(:,:,ro)=missing_data - goto 11 - endif - - do while (len(trim(temp_str)).ne.0) - index_val=index(temp_str,' ') - !write(*,*) index_val,trim(temp_str),len(trim(temp_str)) - if (index_val.gt.1) then - temp_str1=temp_str(1:index_val-1) - i_head=i_head+1 - temp_str=temp_str(index_val+1:) - header_str(i_head)=temp_str1 - !write(unit_logfile,*) i_head,len(temp_str),index_val,trim(header_str(i_head)) + inquire(file=trim(filename_temp),exist=exists) + if (.not.exists) then + write(unit_logfile,'(A,A)') ' WARNING: Meteo obs data file does not exist: ', trim(filename_temp) + goto 12 else - temp_str=temp_str(index_val+1:) - !write(*,*) index_val,len(temp_str),'temp_str',trim(temp_str) - endif + write(unit_logfile,'(2A)') ' Opening obs meteo file: ',trim(filename_temp) + endif + open(unit_in,file=filename_temp,access='sequential',status='old',readonly) - end do - !write(unit_logfile,*) 'Number of columns= ',i_head + !rewind(unit_in) + + !Read in header + !Stnr Year Month Day Time(NMT) UU PO TA RR_1 FF DD QSI NN TV + + !Read header string and split at spaces. Assumes single space seperation + temp_str1='' + temp_str2='Not available' + index_val=1 + i_head=0 + read(unit_in,'(a)',end=11) temp_str !Read the header string + !Check if any data given the ndap format for no data + !write(*,*) temp_str + if (index(temp_str,'****').gt.0) then + input_array(:,:,ro)=missing_data + goto 11 + endif + + do while (len(trim(temp_str)).ne.0) + index_val=index(temp_str,' ') + !write(*,*) index_val,trim(temp_str),len(trim(temp_str)) + if (index_val.gt.1) then + temp_str1=temp_str(1:index_val-1) + i_head=i_head+1 + temp_str=temp_str(index_val+1:) + header_str(i_head)=temp_str1 + !write(unit_logfile,*) i_head,len(temp_str),index_val,trim(header_str(i_head)) + else + temp_str=temp_str(index_val+1:) + !write(*,*) index_val,len(temp_str),'temp_str',trim(temp_str) + endif + + end do + !write(unit_logfile,*) 'Number of columns= ',i_head - !Find out how long the file is, reading a dummy variable - index_val=0 - do while(.not.eof(unit_in)) - index_val=index_val+1 - read(unit_in,*,ERR=6) - enddo - !write(unit_logfile,*) 'Number of rows= ',index_val + !Find out how long the file is, reading a dummy variable + index_val=0 + do while(.not.eof(unit_in)) + index_val=index_val+1 + read(unit_in,*,ERR=6) + enddo + !write(unit_logfile,*) 'Number of rows= ',index_val - !Read data -6 n_meteo_obs_date=int(index_val) - !write(unit_logfile,*) 'Number of stations= ',ro,n_meteo_obs_stations - !write(unit_logfile,*) 'Number of dates= ',n_meteo_obs_date - !allocate (input_array(i_head,index_val)) - if (.not.allocated(input_array)) then - allocate (input_array(i_head,n_meteo_obs_date,n_meteo_obs_stations)) - input_array=missing_data - endif - - start_dim_meteo_obs=1 - end_dim_meteo_obs=n_meteo_obs_date - - rewind(unit_in) - read(unit_in,*,ERR=6) !Skip header - - !read(unit_in,*) (((input_array(ii,jj,ro),ii=1,i_head),jj=1,n_meteo_obs_date),ro=1,n_meteo_obs_stations) - do jj=1,n_meteo_obs_date - read(unit_in,*) read_str(1:i_head) - !write(*,'(a10)') read_str(1:i_head) - do ii=1,i_head - !Set these two string types to missing data for the old obs datasets - index_val3=index(read_str(ii),'x') - index_val1=index(read_str(ii),'-') - index_val2=index(read_str(ii),'.') - if (index_val1.eq.len(trim(read_str(ii))).or.index_val2.eq.len(trim(read_str(ii))).or.index_val3.eq.len(trim(read_str(ii)))) then - input_array(ii,jj,ro)=missing_data - else - read(read_str(ii),*) input_array(ii,jj,ro) - endif - enddo - !write(*,'(f10.2)') input_array(:,jj,ro) - enddo - -11 close(unit_in,status='keep') - -12 enddo - + !Read data +6 n_meteo_obs_date=int(index_val) + !write(unit_logfile,*) 'Number of stations= ',ro,n_meteo_obs_stations + !write(unit_logfile,*) 'Number of dates= ',n_meteo_obs_date + !allocate (input_array(i_head,index_val)) + if (.not.allocated(input_array)) then + allocate (input_array(i_head,n_meteo_obs_date,n_meteo_obs_stations)) + input_array=missing_data + endif + + start_dim_meteo_obs=1 + end_dim_meteo_obs=n_meteo_obs_date + + rewind(unit_in) + read(unit_in,*,ERR=6) !Skip header + + !read(unit_in,*) (((input_array(ii,jj,ro),ii=1,i_head),jj=1,n_meteo_obs_date),ro=1,n_meteo_obs_stations) + do jj=1,n_meteo_obs_date + read(unit_in,*) read_str(1:i_head) + !write(*,'(a10)') read_str(1:i_head) + do ii=1,i_head + !Set these two string types to missing data for the old obs datasets + index_val3=index(read_str(ii),'x') + index_val1=index(read_str(ii),'-') + index_val2=index(read_str(ii),'.') + if (index_val1.eq.len(trim(read_str(ii))).or.index_val2.eq.len(trim(read_str(ii))).or.index_val3.eq.len(trim(read_str(ii)))) then + input_array(ii,jj,ro)=missing_data + else + read(read_str(ii),*) input_array(ii,jj,ro) + endif + enddo + !write(*,'(f10.2)') input_array(:,jj,ro) + enddo +11 close(unit_in,status='keep') +12 enddo endif write(unit_logfile,'(a32,a14,a14,a14)') 'Parameter','First value','Last value','Mean value' @@ -468,9 +423,9 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data input_array(i,1,1),input_array(i,n_meteo_obs_date,n_meteo_obs_stations), & sum(input_array(i,1:n_meteo_obs_date,1:n_meteo_obs_stations)/(n_meteo_obs_date*n_meteo_obs_stations)) end do - write(unit_logfile,'(A)') '----------------------------------------------------------------' + write(unit_logfile,'(A)') '----------------------------------------------------------------' - allocate (meteo_obs_ID_data(n_meteo_obs_date,n_meteo_obs_stations)) + allocate (meteo_obs_ID_data(n_meteo_obs_date,n_meteo_obs_stations)) !TODO: Seems like this is not used further. Can it be deleted? allocate (meteo_obs_date(num_date_index,n_meteo_obs_date)) allocate (meteo_obs_data(num_var_meteo,n_meteo_obs_date,n_meteo_obs_stations)) allocate (meteo_obs_ID_temp(n_meteo_obs_stations)) @@ -504,7 +459,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data !do t=start_dim_meteo_obs,end_dim_meteo_obs !call incrtm(int(-DIFUTC_H),meteo_obs_date(1,t),meteo_obs_date(2,t),meteo_obs_date(3,t),meteo_obs_date(4,t)) !enddo - + !Match the observed meteorology date indexes to the prescribed dates start_time_index_meteo_obs=0 @@ -525,8 +480,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data .and.meteo_obs_date(hour_index,t).eq.date_data(hour_index,n_hours_input)) then end_time_index_meteo_obs=t end_time_index_meteo_obs_found=.true. - endif - + endif enddo hours_time_index_meteo_obs=end_time_index_meteo_obs-start_time_index_meteo_obs+1 @@ -564,10 +518,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data endif enddo enddo - !write(*,*) meteo_obs_ID_temp - !write(*,*) meteo_obs_ID - !write(*,*) meteo_obs_position(meteo_obs_height_index,:) - + !Create the new meteo data using the first station in metadata list and filling up missing data downover !Temperature adjusted for lapse rate allocate (meteo_obs_data_final(num_var_meteo,hours_time_index_meteo_obs)) @@ -714,7 +665,7 @@ subroutine NORTRIP_multiroad_read_meteo_obs_data endif enddo !meteo_obs_data_final(:,:)=meteo_obs_data(:,start_time_index_meteo_obs:end_time_index_meteo_obs,1) - + !Determine how much is still missing write(unit_logfile,'(a)') ' Available meteo obs data' write(unit_logfile,'(a12,a12,a14)') 'Index','Name','Available(%)' diff --git a/NORTRIP_multiroad_read_meteo_obs_data_netcdf.f90 b/NORTRIP_multiroad_read_meteo_obs_data_netcdf.f90 new file mode 100644 index 0000000..2333c4c --- /dev/null +++ b/NORTRIP_multiroad_read_meteo_obs_data_netcdf.f90 @@ -0,0 +1,278 @@ + subroutine NORTRIP_multiroad_read_meteo_obs_data_netcdf + + use NORTRIP_multiroad_index_definitions + use netcdf + + implicit none + + !Local variables + integer i + integer exists + integer :: ncid + integer :: varid + integer :: dimid + character(256) filename + + integer repeat_count + integer :: max_count=5 + real :: max_hop=10. + real :: min_val=-40. + real :: max_val=+40. + real :: max_diff_ta_tv=15. + logical :: test_repetition=.true. + integer new_start_date_input(num_date_index) + double precision temp_date + + !Functions + double precision date_to_number + character(256) replace_string_char + + integer :: s,t + + integer :: status + + logical :: start_time_index_meteo_obs_found + logical :: end_time_index_meteo_obs_found + + !character(256) :: filename_nc,filename_nc_in + + + + write(unit_logfile,'(A)') '================================================================' + write(unit_logfile,'(A)') 'Reading observed meteorological data (NORTRIP_multiroad_read_meteo_obs_data_netcdf)' + write(unit_logfile,'(A)') '================================================================' + + + !If read obs data not specified then return without doing anything + if (replace_meteo_with_obs.eq.0) then + write(unit_logfile,'(a)') 'No observational data used in calculation' + return + endif + + !TODO: Readning of observations should maybe be more flexible; Look further back (e.g. last 3 hours); what if observations are available in the middle of the simulation period, but not the start? + if (timestep.eq.1) then + write(*,*) 'The model timestep is ', timestep, 'h, while the observations are on a 10 min resolution. Looking for suitable obs file. ' + new_start_date_input=start_date_input + do i=1,1 + !call incrtm(-24,new_start_date_input(1),new_start_date_input(2),new_start_date_input(3),new_start_date_input(4)) + temp_date=date_to_number(new_start_date_input,ref_year) + call number_to_date(temp_date-1./24.,new_start_date_input,ref_year) + call date_to_datestr_bracket(new_start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + call date_to_datestr_bracket(new_start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + call date_to_datestr_bracket(new_start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + filename=trim(inpath_meteo_obs_netcdf_data)//trim(infile_meteo_obs_netcdf_data) + write(unit_logfile,'(A,A)') ' Trying: ', trim(filename) + inquire(file=trim(filename),exist=exists) + + enddo + else + !Read in the meteo obs metadata file + !Test existence of the filename. + call date_to_datestr_bracket(start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + call date_to_datestr_bracket(start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + call date_to_datestr_bracket(start_date_input,infile_meteo_obs_netcdf_data_template,infile_meteo_obs_netcdf_data) + filename = trim(inpath_meteo_obs_netcdf_data)//trim(infile_meteo_obs_netcdf_data) + endif + + meteo_obs_data_available=.true. + + inquire(file=trim(filename),exist=exists) + + !File with lat/lon for the stations (metadata): + !/lustre/storeB/project/fou/kl/NORTRIP_Avinor/Runways_2/NORTRIP_measurements/avinor_stationlist_api_20230127_oldID.txt + + if (.not.exists) then + write(unit_logfile,'(a)') "Obsfile not found. Filename: " + write(unit_logfile,'(a)') trim(filename) + write(unit_logfile,'(a)') "Do not use observations in this simulation." + meteo_obs_data_available = .false. + else + write(unit_logfile,'(a)') "Opening obs file: " + write(unit_logfile,'(a)') trim(filename) + call check(nf90_open(filename,NF90_NOWRITE,ncid)) + !Get number of stations from netcdf file with observations + call check(nf90_inq_dimid(ncid, "station_id",dimid)) + call check(nf90_inquire_dimension(ncid, dimid, len=n_meteo_obs_stations)) + + write(unit_logfile,'(a)') "Number of stations in obs file: " + write(*,*) n_meteo_obs_stations + + !Get number of timesteps in netcdf file with observations + call check(nf90_inq_dimid(ncid, "time",dimid)) + call check(nf90_inquire_dimension(ncid, dimid, len=n_meteo_obs_date)) + + write(unit_logfile,'(a)') "Number of time entries in obs file: " + write(*,*) n_meteo_obs_date + + allocate (meteo_obs_ID(n_meteo_obs_stations)) + allocate (meteo_obs_name(n_meteo_obs_stations)) + + !TODO: Setting meteo_obs_position (supposed to hold lat, lon and height data) to zero. + !As far as I can tell, in the "old" setup the lat/lon values are transformed to utm coordinates, but not used any further. The height is used to adjust the lapse rates to estimate the temperature at the surface. + allocate (meteo_obs_position(num_meteo_obs_position,n_meteo_obs_stations)) + meteo_obs_position(:,:)=0. + + allocate (meteo_obs_date(num_date_index,n_meteo_obs_date)) + allocate (meteo_obs_data(num_var_meteo,n_meteo_obs_date,n_meteo_obs_stations)) + + + ! !Put name of the stations as integers into meteo_obs_ID array. + call check(nf90_inq_varid(ncid,"station_id",varid)) + call check(nf90_get_var(ncid,varid,meteo_obs_ID(:))) + + ! Fill meteo_obs_name with string versions of the station names for comparison with receptor links. + do i = 1, size(meteo_obs_ID) + write(meteo_obs_name(i), '(I6)') meteo_obs_ID(i) + meteo_obs_name(i) = trim(meteo_obs_name(i)) + end do + + status = nf90_inq_varid(ncid,"year",varid) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_date(year_index,:))) + else + write(unit_logfile,'(a)') "Could not find variable 'year' in the netcdf file. Do not use obs data in this simulation." + return + end if + + status = nf90_inq_varid(ncid,"month",varid) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_date(month_index,:))) + else + write(unit_logfile,'(a)') "Could not find variable 'month' in the netcdf file. Do not use obs data in this simulation." + return + end if + + status = nf90_inq_varid(ncid,"day",varid) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_date(day_index,:))) + else + write(unit_logfile,'(a)') "Could not find variable 'day' in the netcdf file. Do not use obs data in this simulation." + return + end if + + status = nf90_inq_varid(ncid,"hour",varid) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_date(hour_index,:))) + else + write(unit_logfile,'(a)') "Could not find variable 'hour' in the netcdf file. Do not use obs data in this simulation." + return + end if + + status = nf90_inq_varid(ncid,"minute",varid) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_date(minute_index,:))) + else + write(unit_logfile,'(a)') "Could not find variable 'minute' in the netcdf file. Do not use obs data in this simulation." + return + end if + + status = (nf90_inq_varid(ncid,"air_temperature",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(temperature_index,:,:))) + else + write(unit_logfile,'(a)') "The variable air_temperature was not found in the netcdf file. Setting value to -99." + meteo_obs_data(pressure_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"relative_humidity",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(relhumidity_index,:,:))) + else + write(unit_logfile,'(a)') "The variable relative_humidity was not found in the netcdf file. Setting value to -99." + meteo_obs_data(pressure_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"surface_air_pressure",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(pressure_index,:,:))) + else + write(unit_logfile,'(a)') "The variable surface_air_pressure was not found in the netcdf file. Setting value to -99." + meteo_obs_data(pressure_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"wind_speed",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(speed_wind_index,:,:))) + else + write(unit_logfile,'(a)') "The variable wind_speed was not found in the netcdf file. Setting value to -99." + meteo_obs_data(speed_wind_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"wind_from_direction",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(dir_wind_index,:,:))) + else + write(unit_logfile,'(a)') "The variable wind_from_direction was not found in the netcdf file. Setting value to -99." + meteo_obs_data(dir_wind_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"surface_downwelling_shortwave_flux_in_air",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(shortwaveradiation_index,:,:))) + else + write(unit_logfile,'(a)') "The variable surface_downwelling_shortwave_flux_in_air was not found in the netcdf file. Setting value to -99." + meteo_obs_data(shortwaveradiation_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"surface_downwelling_longwave_flux_in_air",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(longwaveradiation_index,:,:))) + else + write(unit_logfile,'(a)') "The variable surface_downwelling_longwave_flux_in_air was not found in the netcdf file. Setting value to -99." + meteo_obs_data(longwaveradiation_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"precipitation_amount",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(precip_index,:,:))) + else + write(unit_logfile,'(a)') "The variable precipitation_amount was not found in the netcdf file. Setting value to -99." + meteo_obs_data(precip_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"runway_temperature",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(road_temperature_index,:,:))) + else + write(unit_logfile,'(a)') "The variable runway_temperature was not found in the netcdf file. Setting value to -99." + meteo_obs_data(road_temperature_index,:,:) = -99. + end if + + status = (nf90_inq_varid(ncid,"cloud_area_fraction",varid)) + if ( status == nf90_noerr ) then + call check(nf90_get_var(ncid,varid,meteo_obs_data(cloudfraction_index,:,:))) + meteo_obs_data(cloudfraction_index,:,:) = meteo_obs_data(cloudfraction_index,:,:)/8. !! NOTE: converted from octas to fraction by division by 8. + else + write(unit_logfile,'(a)') "The variable cloud_area_fraction was not found in the netcdf file. Setting value to -99." + meteo_obs_data(cloudfraction_index,:,:) = -99. + end if + + call check(nf90_close(ncid)) + + meteo_obs_date(second_index,:) = 0 + start_date_meteo_obs = meteo_obs_date(:,1) + end_date_meteo_obs = meteo_obs_date(:,n_meteo_obs_date) + + allocate(obs_exist(n_meteo_obs_date)) !Array of length equal to number of observations, will be filled with corresponding date_date indexes + obs_exist=0 !Initialize to zero + do i = 1,size(date_data,dim=2) + do t=1,size(meteo_obs_date, dim=2) + + if (date_data(year_index,i) .eq. meteo_obs_date(year_index,t) .and. & + date_data(month_index,i) .eq. meteo_obs_date(month_index,t) .and. & + date_data(day_index,i) .eq. meteo_obs_date(day_index,t) .and. & + date_data(minute_index,i) .eq. meteo_obs_date(minute_index,t) .and. & + date_data(hour_index,i) .eq. meteo_obs_date(hour_index,t)) then + + obs_exist(t) = i + end if + + end do + enddo + + write(unit_logfile,'(a)') "Finished reading obs file." + + end if + +end subroutine NORTRIP_multiroad_read_meteo_obs_data_netcdf + diff --git a/NORTRIP_multiroad_read_region_EF_data.f90 b/NORTRIP_multiroad_read_region_EF_data.f90 index eb5d32a..2e69673 100644 --- a/NORTRIP_multiroad_read_region_EF_data.f90 +++ b/NORTRIP_multiroad_read_region_EF_data.f90 @@ -461,7 +461,7 @@ subroutine NORTRIP_multiroad_read_region_activity_data binding_start_mm(k), & binding_end_mm(k) endif - !write(*,*) k,k_index,region_id(k) + enddo diff --git a/NORTRIP_multiroad_read_skyview_data.f90 b/NORTRIP_multiroad_read_skyview_data.f90 index f59aa65..fc218ce 100644 --- a/NORTRIP_multiroad_read_skyview_data.f90 +++ b/NORTRIP_multiroad_read_skyview_data.f90 @@ -50,7 +50,7 @@ subroutine NORTRIP_multiroad_read_skyview_data write(*,*) trim(temp_str),n_skyview_in !Test for compatibility - !write(*,*) n_roadlinks_in,n_roadlinks,n_skyview_in,n_skyview + write(*,*) n_roadlinks_in,n_roadlinks,n_skyview_in,n_skyview if (n_roadlinks_in.eq.n_roadlinks.and.n_skyview_in.eq.n_skyview) then !write(unit_in,'(A8,6A14,f8.1)') 'Road','RoadLinkID','Elevation','Can_dis_N','Can_dis_S','Can_height_N','Can_height_S',(az_skyview(s,1),s=1,n_skyview) @@ -71,7 +71,10 @@ subroutine NORTRIP_multiroad_read_skyview_data enddo else - write(unit_logfile,'(a)') ' WARNING: Road link, skyview and canyon parameters incompatable. Not reading these parameters' + write(unit_logfile,'(a)') ' WARNING: Road link, skyview and canyon parameters incompatable. Not reading these parameters. Setting canyon width to 20.' + !To avoid a divide by 0 + inputdata_rl(canyondist_north_rl_index,:)=10. + inputdata_rl(canyondist_south_rl_index,:)=10. endif close (unit_in) diff --git a/NORTRIP_multiroad_read_staticroadlink_data.f90 b/NORTRIP_multiroad_read_staticroadlink_data.f90 index c2a3afa..7297ce2 100644 --- a/NORTRIP_multiroad_read_staticroadlink_data.f90 +++ b/NORTRIP_multiroad_read_staticroadlink_data.f90 @@ -1,6 +1,6 @@ !NORTRIP_multiroad_read_staticroadlink_data.f90 - subroutine NORTRIP_multiroad_read_staticroadlink_data +subroutine NORTRIP_multiroad_read_staticroadlink_data !Old routine for reading BB data use NORTRIP_multiroad_index_definitions @@ -203,10 +203,10 @@ subroutine NORTRIP_multiroad_read_staticroadlink_data !NOTE: Some links are very short (1 m) so question of whether to include these or not !NOTE: Question of whether to aggregate for common traffic ID? - end subroutine NORTRIP_multiroad_read_staticroadlink_data +end subroutine NORTRIP_multiroad_read_staticroadlink_data - subroutine NORTRIP_multiroad_reorder_staticroadlink_data +subroutine NORTRIP_multiroad_reorder_staticroadlink_data use NORTRIP_multiroad_index_definitions @@ -435,10 +435,10 @@ subroutine NORTRIP_multiroad_reorder_staticroadlink_data if (allocated(traffic_data_temp)) deallocate(traffic_data_temp) if (allocated(airquality_data_temp)) deallocate(airquality_data_temp) - end subroutine NORTRIP_multiroad_reorder_staticroadlink_data +end subroutine NORTRIP_multiroad_reorder_staticroadlink_data - subroutine NORTRIP_multiroad_read_staticroadlink_data_ascii +subroutine NORTRIP_multiroad_read_staticroadlink_data_ascii !New routine for reading static data use NORTRIP_multiroad_index_definitions @@ -574,35 +574,33 @@ subroutine NORTRIP_multiroad_read_staticroadlink_data_ascii !write(*,*) n_subnodes,inputdata_int_rl(n_subnodes_rl_index,counter),step_sublinks else - do j=1,n_subnodes-1 - counter=counter+1 - inputdata_int_rl(id_rl_index,counter)=temp_id - inputdata_rl(adt_rl_index,counter)=temp_adt - inputdata_rl(hdv_rl_index,counter)=temp_hdv - inputdata_int_rl(roadactivitytype_rl_index,counter)=temp_road_category !temp_road_activity_type - inputdata_rl(speed_rl_index,counter)=temp_speed - inputdata_rl(width_rl_index,counter)=temp_width - inputdata_rl(x1_rl_index,counter)=sub_nodes_x(j) - inputdata_rl(x2_rl_index,counter)=sub_nodes_x(j+1) - inputdata_int_rl(nlanes_rl_index,counter)=temp_nlanes - inputdata_rl(y1_rl_index,counter)=sub_nodes_y(j) - inputdata_rl(y2_rl_index,counter)=sub_nodes_y(j+1) - inputdata_rl(length_rl_index,counter)=sqrt((inputdata_rl(x1_rl_index,counter)-inputdata_rl(x2_rl_index,counter))**2+(inputdata_rl(y1_rl_index,counter)-inputdata_rl(y2_rl_index,counter))**2) - !write(*,*) inputdata_int_rl(id_rl_index,counter),inputdata_rl(x1_rl_index,counter),inputdata_rl(y2_rl_index,counter) - inputdata_int_rl(roadcategory_rl_index,counter)=temp_road_category !Not used in NORTRIP, see roadactivitytype_rl_index - inputdata_int_rl(region_id_rl_index,counter)=temp_region_id - inputdata_int_rl(roadstructuretype_rl_index,counter)=temp_road_structure_type - inputdata_int_rl(roadsurface_id_rl_index,counter)=temp_surface_id - !inputdata_int_rl(tunnel_length_rl_index,counter)=temp_tunnel_length - inputdata_rl_sub(x1_rl_index,1,counter)=inputdata_rl(x1_rl_index,counter) - inputdata_rl_sub(x2_rl_index,1,counter)=inputdata_rl(x2_rl_index,counter) - inputdata_rl_sub(y1_rl_index,1,counter)=inputdata_rl(y1_rl_index,counter) - inputdata_rl_sub(y2_rl_index,1,counter)=inputdata_rl(y2_rl_index,counter) - - enddo - inputdata_int_rl(n_subnodes_rl_index,counter)=2 + do j=1,n_subnodes-1 + counter=counter+1 + inputdata_int_rl(id_rl_index,counter)=temp_id + inputdata_rl(adt_rl_index,counter)=temp_adt + inputdata_rl(hdv_rl_index,counter)=temp_hdv + inputdata_int_rl(roadactivitytype_rl_index,counter)=temp_road_category !temp_road_activity_type + inputdata_rl(speed_rl_index,counter)=temp_speed + inputdata_rl(width_rl_index,counter)=temp_width + inputdata_rl(x1_rl_index,counter)=sub_nodes_x(j) + inputdata_rl(x2_rl_index,counter)=sub_nodes_x(j+1) + inputdata_int_rl(nlanes_rl_index,counter)=temp_nlanes + inputdata_rl(y1_rl_index,counter)=sub_nodes_y(j) + inputdata_rl(y2_rl_index,counter)=sub_nodes_y(j+1) + inputdata_rl(length_rl_index,counter)=sqrt((inputdata_rl(x1_rl_index,counter)-inputdata_rl(x2_rl_index,counter))**2+(inputdata_rl(y1_rl_index,counter)-inputdata_rl(y2_rl_index,counter))**2) + !write(*,*) inputdata_int_rl(id_rl_index,counter),inputdata_rl(x1_rl_index,counter),inputdata_rl(y2_rl_index,counter) + inputdata_int_rl(roadcategory_rl_index,counter)=temp_road_category !Not used in NORTRIP, see roadactivitytype_rl_index + inputdata_int_rl(region_id_rl_index,counter)=temp_region_id + inputdata_int_rl(roadstructuretype_rl_index,counter)=temp_road_structure_type + inputdata_int_rl(roadsurface_id_rl_index,counter)=temp_surface_id + !inputdata_int_rl(tunnel_length_rl_index,counter)=temp_tunnel_length + inputdata_rl_sub(x1_rl_index,1,counter)=inputdata_rl(x1_rl_index,counter) + inputdata_rl_sub(x2_rl_index,1,counter)=inputdata_rl(x2_rl_index,counter) + inputdata_rl_sub(y1_rl_index,1,counter)=inputdata_rl(y1_rl_index,counter) + inputdata_rl_sub(y2_rl_index,1,counter)=inputdata_rl(y2_rl_index,counter) + enddo + inputdata_int_rl(n_subnodes_rl_index,counter)=2 endif - !endif enddo n_roadlinks=counter write(unit_logfile,'(a,i)') ' Number of road links used = ', n_roadlinks @@ -709,7 +707,7 @@ subroutine NORTRIP_multiroad_read_staticroadlink_data_ascii stop 17 - end subroutine NORTRIP_multiroad_read_staticroadlink_data_ascii +end subroutine NORTRIP_multiroad_read_staticroadlink_data_ascii !---------------------------------------------------------------------- subroutine NORTRIP_multiroad_read_staticroadlink_data_gridded @@ -950,7 +948,7 @@ end subroutine NORTRIP_multiroad_read_staticroadlink_data_gridded !---------------------------------------------------------------------- - subroutine NORTRIP_multiroad_read_replace_road_data +subroutine NORTRIP_multiroad_read_replace_road_data use NORTRIP_multiroad_index_definitions @@ -1232,5 +1230,5 @@ subroutine NORTRIP_multiroad_read_replace_road_data deallocate(inputdata_rl_replaced_flag) deallocate(inputdata_int_rl_replaced_flag) - end subroutine NORTRIP_multiroad_read_replace_road_data +end subroutine NORTRIP_multiroad_read_replace_road_data !---------------------------------------------------------------------- diff --git a/NORTRIP_multiroad_read_weekdynamictraffic_data.f90 b/NORTRIP_multiroad_read_weekdynamictraffic_data.f90 index c63a5fb..23d3ec5 100644 --- a/NORTRIP_multiroad_read_weekdynamictraffic_data.f90 +++ b/NORTRIP_multiroad_read_weekdynamictraffic_data.f90 @@ -1,6 +1,6 @@ !NORTRIP_multiroad_read_weekdynamictraffic_data.f90 - subroutine NORTRIP_multiroad_read_weekdynamictraffic_data +subroutine NORTRIP_multiroad_read_weekdynamictraffic_data use NORTRIP_multiroad_index_definitions @@ -12,7 +12,7 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data integer unit_in integer i,t,d,h,v,ty integer rl_length_short - integer exists + logical exists logical nxtdat_flag integer week_day_temp,hour_temp real tyre_fraction(num_veh,num_tyre) @@ -55,7 +55,6 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data stop 19 endif - !write(*,*) num_week_traffic,days_in_week,hours_in_day,n_roadlinks if (index(timevariation_type,'NUDL').gt.0) then allocate (inputdata_hour_traffic(3,2,2,days_in_week,hours_in_day)) allocate (inputdata_month_traffic(3,2,2,months_in_year)) @@ -105,115 +104,79 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data ,inputdata_month_traffic(3,1,1,m),inputdata_month_traffic(3,1,2,m),inputdata_month_traffic(3,2,1,m),inputdata_month_traffic(3,2,2,m) enddo - close(unit_in,status='keep') + close(unit_in,status='keep') - !The NUDL data is normalised but we do it anyway - if (index(calculation_type,'road weather').gt.0.or.index(calculation_type,'uEMEP').gt.0.or.index(calculation_type,'Avinor').gt.0.or.index(calculation_type,'gridded').gt.0) then - do l=1,3 - do m=1,2 - do n=1,2 - hour_normalise=sum(inputdata_hour_traffic(l,m,n,:,:)) - month_normalise=sum(inputdata_month_traffic(l,m,n,:)) - inputdata_hour_traffic(l,m,n,:,:)=inputdata_hour_traffic(l,m,n,:,:)/hour_normalise*7. - inputdata_month_traffic(l,m,n,:)=inputdata_month_traffic(l,m,n,:)/month_normalise*12. - !write(*,*) l,m,n,sum(inputdata_hour_traffic(l,m,n,:,:)) - !write(*,*) l,m,n,sum(inputdata_month_traffic(l,m,n,:)) - enddo - enddo - enddo - else - write(unit_logfile,'(a)') 'Cannot process NUDL data for this calculation type. Stopping' - stop - endif + !The NUDL data is normalised but we do it anyway + if (index(calculation_type,'road weather').gt.0.or.index(calculation_type,'uEMEP').gt.0.or.index(calculation_type,'Avinor').gt.0.or.index(calculation_type,'gridded').gt.0) then + do l=1,3 + do m=1,2 + do n=1,2 + hour_normalise=sum(inputdata_hour_traffic(l,m,n,:,:)) + month_normalise=sum(inputdata_month_traffic(l,m,n,:)) + inputdata_hour_traffic(l,m,n,:,:)=inputdata_hour_traffic(l,m,n,:,:)/hour_normalise*7. + inputdata_month_traffic(l,m,n,:)=inputdata_month_traffic(l,m,n,:)/month_normalise*12. + enddo + enddo + enddo + else + write(unit_logfile,'(a)') 'Cannot process NUDL data for this calculation type. Stopping' + stop + endif else - - - !Read the normal data - t=0 - do d=1,days_in_week - do h=1,hours_in_day - do i=1,n_roadlinks_read - t=t+1 - read(unit_in,*,ERR=10) & - hour_week_traffic(d,h,i) & - ,temp_id & - ,inputdata_week_traffic(N_week_index,d,h,i) & - ,inputdata_week_traffic(HDV_week_index,d,h,i) & - ,inputdata_week_traffic(V_week_index,d,h,i) - !write(*,*) d,hour_week_traffic(d,h,i),temp_id,inputdata_week_traffic(N_week_index,d,h,i) + !Read the normal data + t=0 + do d=1,days_in_week + do h=1,hours_in_day + do i=1,n_roadlinks_read + t=t+1 + read(unit_in,*,ERR=10) & + hour_week_traffic(d,h,i) & + ,temp_id & + ,inputdata_week_traffic(N_week_index,d,h,i) & + ,inputdata_week_traffic(HDV_week_index,d,h,i) & + ,inputdata_week_traffic(V_week_index,d,h,i) + enddo + enddo enddo - enddo - enddo - - close(unit_in,status='keep') - - if (index(timevariation_type,'normal2').gt.0) then - write(unit_logfile,'(a)') 'Using time profile with LDV and HDV timeprofiles seperately, i.e. normal2' - inputdata_week_traffic(LDV_week_index,:,:,:)=inputdata_week_traffic(N_week_index,:,:,:) - - else - !Calculate the HDV profile first - write(unit_logfile,'(a)') 'Using incorrect time profiles with NTOTAL and HDV% timeprofiles seperately, i.e. normal. Works for HDV around 10%' - - average_HDV=sum(inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read))/size(inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)) - inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)=inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)*inputdata_week_traffic(N_week_index,:,:,n_roadlinks_read)/average_HDV - endif - - if (index(calculation_type,'road weather').gt.0.or.index(calculation_type,'uEMEP').gt.0.or.index(calculation_type,'Avinor').gt.0.or.index(calculation_type,'gridded').gt.0) then - N_normalise=sum(inputdata_week_traffic(N_week_index,:,:,n_roadlinks_read))/7. - HDV_normalise=sum(inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read))/7. - LDV_normalise=sum(inputdata_week_traffic(LDV_week_index,:,:,n_roadlinks_read))/7. - !HDV_normalise=sum(inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read))/size(inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)) - V_normalise=sum(inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read))/size(inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read)) - !write(*,*) N_normalise,HDV_normalise,LDV_normalise,t - !Loop downwards so that the first value (n_roadlinks_read) is updated last - if (index(timevariation_type,'normal2').gt.0) then - do i=n_roadlinks,1,-1 - inputdata_week_traffic(LDV_week_index,:,:,i)=inputdata_week_traffic(LDV_week_index,:,:,n_roadlinks_read)/LDV_normalise*inputdata_rl(adt_rl_index,i)*(1.-inputdata_rl(hdv_rl_index,i)/100.) - inputdata_week_traffic(HDV_week_index,:,:,i)=inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)/HDV_normalise*inputdata_rl(adt_rl_index,i)*inputdata_rl(hdv_rl_index,i)/100. - inputdata_week_traffic(N_week_index,:,:,i)=inputdata_week_traffic(LDV_week_index,:,:,i)+inputdata_week_traffic(HDV_week_index,:,:,i) - inputdata_week_traffic(V_week_index,:,:,i)=inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read)/V_normalise*inputdata_rl(speed_rl_index,i) - hour_week_traffic(:,:,i)=hour_week_traffic(:,:,n_roadlinks_read) - !if (i.eq.19) write(*,*) sum(inputdata_week_traffic(N_week_index,:,:,i))/7.,inputdata_rl(adt_rl_index,i),sum(inputdata_week_traffic(HDV_week_index,:,:,i))/7.,inputdata_rl(adt_rl_index,i)*inputdata_rl(hdv_rl_index,i)/100. - enddo - else - do i=n_roadlinks,1,-1 - inputdata_week_traffic(N_week_index,:,:,i)=inputdata_week_traffic(N_week_index,:,:,n_roadlinks_read)/N_normalise*inputdata_rl(adt_rl_index,i) - !inputdata_week_traffic(HDV_week_index,:,:,i)=inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)/HDV_normalise*inputdata_rl(hdv_rl_index,i) - inputdata_week_traffic(HDV_week_index,:,:,i)=inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)/HDV_normalise*inputdata_rl(hdv_rl_index,i)/100.*inputdata_rl(adt_rl_index,i) - inputdata_week_traffic(V_week_index,:,:,i)=inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read)/V_normalise*inputdata_rl(speed_rl_index,i) - hour_week_traffic(:,:,i)=hour_week_traffic(:,:,n_roadlinks_read) - !if (i.eq.19) write(*,*) sum(inputdata_week_traffic(N_week_index,:,:,i))/7.,inputdata_rl(adt_rl_index,i),sum(inputdata_week_traffic(HDV_week_index,:,:,i))/7.,inputdata_rl(adt_rl_index,i)*inputdata_rl(hdv_rl_index,i)/100. - enddo - endif - - endif - + close(unit_in,status='keep') + + if (index(timevariation_type,'normal').gt.0) then + write(unit_logfile,'(a)') 'Using time profile with LDV and HDV timeprofiles seperately, i.e. normal' + + inputdata_week_traffic(LDV_week_index,:,:,:)=inputdata_week_traffic(N_week_index,:,:,:) + + else + write(unit_logfile,'(a)') "ERROR: Timevariation type must be either 'normal' or 'NUDL'. Stopping." + stop + endif + + if (index(calculation_type,'road weather').gt.0.or.index(calculation_type,'uEMEP').gt.0.or.index(calculation_type,'Avinor').gt.0.or.index(calculation_type,'gridded').gt.0) then + N_normalise=sum(inputdata_week_traffic(N_week_index,:,:,n_roadlinks_read))/7. + HDV_normalise=sum(inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read))/7. + LDV_normalise=sum(inputdata_week_traffic(LDV_week_index,:,:,n_roadlinks_read))/7. + V_normalise=sum(inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read))/size(inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read)) + !Loop downwards so that the first value (n_roadlinks_read) is updated last + if (index(timevariation_type,'normal').gt.0) then + do i=n_roadlinks,1,-1 + inputdata_week_traffic(LDV_week_index,:,:,i)=inputdata_week_traffic(LDV_week_index,:,:,n_roadlinks_read)/LDV_normalise*inputdata_rl(adt_rl_index,i)*(1.-inputdata_rl(hdv_rl_index,i)/100.) + inputdata_week_traffic(HDV_week_index,:,:,i)=inputdata_week_traffic(HDV_week_index,:,:,n_roadlinks_read)/HDV_normalise*inputdata_rl(adt_rl_index,i)*inputdata_rl(hdv_rl_index,i)/100. + inputdata_week_traffic(N_week_index,:,:,i)=inputdata_week_traffic(LDV_week_index,:,:,i)+inputdata_week_traffic(HDV_week_index,:,:,i) + inputdata_week_traffic(V_week_index,:,:,i)=inputdata_week_traffic(V_week_index,:,:,n_roadlinks_read)/V_normalise*inputdata_rl(speed_rl_index,i) + hour_week_traffic(:,:,i)=hour_week_traffic(:,:,n_roadlinks_read) + !if (i.eq.19) write(*,*) sum(inputdata_week_traffic(N_week_index,:,:,i))/7.,inputdata_rl(adt_rl_index,i),sum(inputdata_week_traffic(HDV_week_index,:,:,i))/7.,inputdata_rl(adt_rl_index,i)*inputdata_rl(hdv_rl_index,i)/100. + enddo + else + write(unit_logfile,'(a)') "ERROR: Timevariation type must be either 'normal' or 'NUDL'. Stopping." + stop + endif + endif + endif - !Write example to log file - !write(unit_logfile,'(a12,5a12)') ' LINK ','HOUR','ID','N','ADT(%)','SPEED' - i=1;d=1;h=1 - do d=1,days_in_week - do h=1,hours_in_day - !write(unit_logfile,'(a12,2i12,3f12.2)') ' First link = ',hour_week_traffic(d,h,i),inputdata_int_rl(id_rl_index,i) & - ! ,inputdata_week_traffic(N_week_index,d,h,i),inputdata_week_traffic(HDV_week_index,d,h,i) & - ! ,inputdata_week_traffic(V_week_index,d,h,i) - enddo - enddo - i=n_roadlinks;d=days_in_week;h=hours_in_day - do d=1,days_in_week - do h=1,hours_in_day - !write(unit_logfile,'(a12,2i12,3f12.2)') ' Last link = ',hour_week_traffic(d,h,i),inputdata_int_rl(id_rl_index,i) & - ! ,inputdata_week_traffic(N_week_index,d,h,i),inputdata_week_traffic(HDV_week_index,d,h,i) & - ! ,inputdata_week_traffic(V_week_index,d,h,i) - enddo - enddo !Put input data traffic into output traffic data file - !write(*,*) num_traffic_index,n_hours_input,n_roadlinks allocate (traffic_data(num_traffic_index,n_hours_input,n_roadlinks)) write(unit_logfile,'(a)') ' Restistributing weekly traffic in model dates (UTC): ' @@ -249,15 +212,17 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data if (week_of_year.lt.1) week_of_year=52 if (week_of_year.gt.52) week_of_year=52 - !Cannot trust this routine. Do as in uEMEP - !call incrtm(int(DIFUTC_H_traffic_temp),date_data_temp(1),date_data_temp(2),date_data_temp(3),date_data_temp(4)) !This could be right now. Test with an end of week date week_day_temp=day_of_week(date_data_temp(:)) - !write(*,'(a,3i6,i)') 'IN: ',t,week_day_temp,hour_temp,0 write(*,'(a,i4,3i5,3i8)') 'DATES(t,yyyy,mm,dd,day,week,week_day): ',t,date_data_temp(1:3),julian_day,week_of_year,week_day_temp - hour_temp=date_data_temp(hour_index)+DIFUTC_H_traffic_temp + if ( timesteps_in_hour > 1 ) then + hour_temp=date_data_temp(hour_index)+DIFUTC_H_traffic_temp+1 + else + hour_temp=date_data_temp(hour_index)+DIFUTC_H_traffic_temp + endif + if (hour_temp.le.0) then hour_temp=24+hour_temp week_day_temp=week_day_temp-1 @@ -272,122 +237,91 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data if (week_day_temp.eq.0) then week_day_temp=7 endif - !write(*,'(a,3i6,i)') 'OUT: ',t,week_day_temp,hour_temp,int(DIFUTC_H_traffic_temp) - !hour_temp=(week_day_temp-1)*24+date_data_temp(4)+DIFUTC_H_traffic_temp - !if (hour_temp.gt.hours_in_week) hour_temp=hour_temp-hours_in_week - !if (hour_temp.lt.1) hour_temp=hour_temp+hours_in_week - if (index(timevariation_type,'NUDL').gt.0) then - do i=1,n_roadlinks - !Find the road category - if (inputdata_int_rl(roadcategory_rl_index,i).eq.1.or.inputdata_int_rl(roadcategory_rl_index,i).eq.2) then - m=1 - elseif (inputdata_int_rl(roadcategory_rl_index,i).eq.3.or.inputdata_int_rl(roadcategory_rl_index,i).eq.4) then - m=2 - else - m=1 !Default is busy roads - endif - !Find the region and exit loop when found. If not found then use the high population value - n=0 - do k=1,n_region - if (inputdata_int_rl(region_id_rl_index,i).eq.population_region_id(k)) then - if (population_region_scaling(k).ge.population_cutoff) then - n=1 - elseif (population_region_scaling(k).lt.population_cutoff) then - n=2 - else - n=1 !Default is high population - endif - exit - endif - enddo - if (n.eq.0) then - write(unit_logfile,*) 'WARNING: Could not find region ID ',i,population_region_id(k) - write(unit_logfile,*) 'WARNING: Setting to 1 (> population_cutoff)' - n=1 - endif - - !Use only the short and long categories, since do not have the middle categories + do i=1,n_roadlinks + !Find the road category + if (inputdata_int_rl(roadcategory_rl_index,i).eq.1.or.inputdata_int_rl(roadcategory_rl_index,i).eq.2) then + m=1 + elseif (inputdata_int_rl(roadcategory_rl_index,i).eq.3.or.inputdata_int_rl(roadcategory_rl_index,i).eq.4) then + m=2 + else + m=1 !Default is busy roads + endif + !Find the region and exit loop when found. If not found then use the high population value + n=0 + do k=1,n_region + if (inputdata_int_rl(region_id_rl_index,i).eq.population_region_id(k)) then + if (population_region_scaling(k).ge.population_cutoff) then + n=1 + elseif (population_region_scaling(k).lt.population_cutoff) then + n=2 + else + n=1 !Default is high population + endif + exit + endif + enddo + if (n.eq.0) then + write(unit_logfile,*) 'WARNING: Could not find region ID ',i,population_region_id(k) + write(unit_logfile,*) 'WARNING: Setting to 1 (> population_cutoff)' + n=1 + endif + + !Use only the short and long categories, since do not have the middle categories traffic_data(N_li_index,t,i)=inputdata_hour_traffic(1,m,n,week_day_temp,hour_temp)*inputdata_month_traffic(1,m,n,month_temp)*inputdata_rl(adt_rl_index,i)*(100.-inputdata_rl(hdv_rl_index,i))/100. traffic_data(N_he_index,t,i)=inputdata_hour_traffic(3,m,n,week_day_temp,hour_temp)*inputdata_month_traffic(3,m,n,month_temp)*inputdata_rl(adt_rl_index,i)*inputdata_rl(hdv_rl_index,i)/100. traffic_data(N_total_index,t,i)=traffic_data(N_li_index,t,i)+traffic_data(N_he_index,t,i) traffic_data(V_li_index,t,i)=inputdata_rl(speed_rl_index,i) traffic_data(V_he_index,t,i)=traffic_data(V_li_index,t,i) - !write(*,'(7i,2f)') t,i,population_region_id(k),m,n,week_day_temp,month_temp,inputdata_hour_traffic(1,m,n,week_day_temp,hour_temp),inputdata_month_traffic(1,m,n,month_temp) - - enddo - - + + enddo + else - if (index(timevariation_type,'normal2').gt.0) then - do i=1,n_roadlinks - traffic_data(N_total_index,t,i)=inputdata_week_traffic(N_week_index,week_day_temp,hour_temp,i) - traffic_data(N_he_index,t,i)=inputdata_week_traffic(HDV_week_index,week_day_temp,hour_temp,i) - traffic_data(N_li_index,t,i)=inputdata_week_traffic(LDV_week_index,week_day_temp,hour_temp,i) - traffic_data(V_li_index,t,i)=inputdata_week_traffic(V_week_index,week_day_temp,hour_temp,i) - traffic_data(V_he_index,t,i)=traffic_data(V_li_index,t,i) - !if (i.eq.19) write(*,*) t,traffic_data(N_total_index,t,i),traffic_data(N_li_index,t,i),traffic_data(N_he_index,t,i) - enddo + if (index(timevariation_type,'normal').gt.0) then + do i=1,n_roadlinks + traffic_data(N_total_index,t,i)=inputdata_week_traffic(N_week_index,week_day_temp,hour_temp,i) + traffic_data(N_he_index,t,i)=inputdata_week_traffic(HDV_week_index,week_day_temp,hour_temp,i) + traffic_data(N_li_index,t,i)=inputdata_week_traffic(LDV_week_index,week_day_temp,hour_temp,i) + traffic_data(V_li_index,t,i)=inputdata_week_traffic(V_week_index,week_day_temp,hour_temp,i) + traffic_data(V_he_index,t,i)=traffic_data(V_li_index,t,i) + enddo else - - do i=1,n_roadlinks - traffic_data(N_total_index,t,i)=inputdata_week_traffic(N_week_index,week_day_temp,hour_temp,i) - traffic_data(N_he_index,t,i)=inputdata_week_traffic(HDV_week_index,week_day_temp,hour_temp,i) - traffic_data(N_li_index,t,i)=traffic_data(N_total_index,t,i)-inputdata_week_traffic(HDV_week_index,week_day_temp,hour_temp,i) - !traffic_data(N_he_index,t,i)=traffic_data(N_total_index,t,i) & - ! *(inputdata_week_traffic(HDV_week_index,week_day_temp,hour_temp,i))/100. - !traffic_data(N_li_index,t,i)=traffic_data(N_total_index,t,i) & - ! *(100.-inputdata_week_traffic(HDV_week_index,week_day_temp,hour_temp,i))/100. - traffic_data(V_li_index,t,i)=inputdata_week_traffic(V_week_index,week_day_temp,hour_temp,i) - traffic_data(V_he_index,t,i)=traffic_data(V_li_index,t,i) - !if (i.eq.19) write(*,*) t,traffic_data(N_total_index,t,i),traffic_data(N_li_index,t,i),traffic_data(N_he_index,t,i) - - !Don't allow negative values that can occur when using 'normal' time profile type - traffic_data(N_he_index,t,i)=min(traffic_data(N_he_index,t,i),traffic_data(N_total_index,t,i)) - traffic_data(N_li_index,t,i)=min(traffic_data(N_li_index,t,i),traffic_data(N_total_index,t,i)) - traffic_data(N_he_index,t,i)=max(traffic_data(N_he_index,t,i),0.) - traffic_data(N_li_index,t,i)=max(traffic_data(N_li_index,t,i),0.) - - enddo + write(unit_logfile,'(a)') "ERROR: Timevariation type must be either 'normal' or 'NUDL'. Stopping." + stop endif - endif - enddo - - - + !Calculate the studded tyre share - !do t=1,n_hours_input !Use the first hour to sett the studded tyres - t=1 - !Set years for studded tyre season comparison. Assumes the end of season is the following year + t=1 + !Set years for studded tyre season comparison. Assumes the end of season is the following year + start_stud_season(year_index)=date_data(year_index,t) + if (date_to_number(date_data(:,t),ref_year).gt.date_to_number(start_stud_season,ref_year)) then start_stud_season(year_index)=date_data(year_index,t) - if (date_to_number(date_data(:,t),ref_year).gt.date_to_number(start_stud_season,ref_year)) then - start_stud_season(year_index)=date_data(year_index,t) - start_full_stud_season(year_index)=date_data(year_index,t) - else - start_stud_season(year_index)=date_data(year_index,t)-1 - start_full_stud_season(year_index)=date_data(year_index,t)-1 - endif - end_stud_season(year_index)=start_stud_season(year_index)+1 - end_full_stud_season(year_index)=start_full_stud_season(year_index)+1 - - !All tyres are summer is set as default - tyre_fraction=0. - do v=1,num_veh + start_full_stud_season(year_index)=date_data(year_index,t) + else + start_stud_season(year_index)=date_data(year_index,t)-1 + start_full_stud_season(year_index)=date_data(year_index,t)-1 + endif + end_stud_season(year_index)=start_stud_season(year_index)+1 + end_full_stud_season(year_index)=start_full_stud_season(year_index)+1 + + !All tyres are summer is set as default + tyre_fraction=0. + do v=1,num_veh tyre_fraction(v,su)=1.-min_stud_fraction(v)/100. tyre_fraction(v,st)=min_stud_fraction(v)/100. - enddo - - !Start of season - do v=1,num_veh + enddo + + !Start of season + do v=1,num_veh if (date_to_number(date_data(:,t),ref_year).gt.date_to_number(start_stud_season,ref_year).and.date_to_number(date_data(:,t),ref_year).lt.date_to_number(start_full_stud_season,ref_year)) then factor_temp=(date_to_number(date_data(:,t),ref_year)-date_to_number(start_stud_season,ref_year))/(date_to_number(start_full_stud_season,ref_year)-date_to_number(start_stud_season,ref_year)) tyre_fraction(v,su)=(1.-factor_temp) @@ -408,24 +342,18 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data tyre_fraction(v,st)=max(max_stud_fraction(v),min_stud_fraction(v))/100.*factor_temp tyre_fraction(v,wi)=factor_temp*(1.-max(max_stud_fraction(v),min_stud_fraction(v))/100.) endif - enddo - - !write(*,*) tyre_fraction(li,:) - !do t=1,n_hours_input - do i=1,n_roadlinks - do v=1,num_veh - do ty=1,num_tyre - traffic_data(N_t_v_index(ty,v),1:n_hours_input,i)=traffic_data(N_v_index(v),1:n_hours_input,i)*tyre_fraction(v,ty) - !if (i.eq.19) then - ! write(*,*) v,ty,tyre_fraction(v,ty) - ! write(*,*) traffic_data(N_v_index(v),1:n_hours_input,i) - !endif - enddo - + enddo + + + do i=1,n_roadlinks + do v=1,num_veh + do ty=1,num_tyre + !print*, + traffic_data(N_t_v_index(ty,v),1:n_hours_input,i)=traffic_data(N_v_index(v),1:n_hours_input,i)*tyre_fraction(v,ty) enddo - enddo - !enddo - + enddo + enddo + if (.not.allocated(airquality_data)) allocate (airquality_data(num_airquality_index,n_hours_input,n_roadlinks)) !Calculate the studded tyre share for each road link based on the region_id @@ -446,7 +374,6 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data !Write example to log file write(unit_logfile,'(5a8,11a8)') 'NUM','YEAR','MONTH','DAY','HOUR','N','N_HE','N_LI','N_ST_HE','N_ST_LI','N_WI_HE','N_WI_LI','N_SU_HE','N_SU_LI','V_HE','V_LI' i=1 - !write(*,'(2f,2i,2f)') inputdata_rl(adt_rl_index,i),inputdata_rl(hdv_rl_index,i),week_day_temp,month_temp,sum(traffic_data(N_total_index,:,i)) do t=1,n_hours_input write(unit_logfile,'(5i8,11f8.1)') t,date_data(1:4,t),traffic_data(N_total_index,t,i) & ,traffic_data(N_v_index(he),t,i),traffic_data(N_v_index(li),t,i) & @@ -455,14 +382,7 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data ,traffic_data(N_t_v_index(su,he),t,i),traffic_data(N_t_v_index(su,li),t,i) & ,traffic_data(V_he_index,t,i),traffic_data(V_li_index,t,i) enddo - !t=n_hours_input - ! write(unit_logfile,'(5i8,11f8.1)') t,date_data(1:4,t),traffic_data(N_total_index,t,1) & - !! ,traffic_data(N_v_index(he),t,i),traffic_data(N_v_index(li),t,i) & - ! ,traffic_data(N_t_v_index(st,he),t,i),traffic_data(N_t_v_index(st,li),t,i) & - ! ,traffic_data(N_t_v_index(wi,he),t,i),traffic_data(N_t_v_index(wi,li),t,i) & - ! ,traffic_data(N_t_v_index(su,he),t,i),traffic_data(N_t_v_index(su,li),t,i) & - ! ,traffic_data(V_he_index,t,i),traffic_data(V_li_index,t,i) - + if (allocated(inputdata_week_traffic)) deallocate(inputdata_week_traffic) if (allocated(hour_week_traffic)) deallocate(hour_week_traffic) @@ -476,4 +396,4 @@ subroutine NORTRIP_multiroad_read_weekdynamictraffic_data stop 19 - end subroutine NORTRIP_multiroad_read_weekdynamictraffic_data \ No newline at end of file +end subroutine NORTRIP_multiroad_read_weekdynamictraffic_data \ No newline at end of file diff --git a/NORTRIP_multiroad_save_initialdata.f90 b/NORTRIP_multiroad_save_initialdata.f90 index c984ce2..ec3279e 100644 --- a/NORTRIP_multiroad_save_initialdata.f90 +++ b/NORTRIP_multiroad_save_initialdata.f90 @@ -120,5 +120,4 @@ subroutine NORTRIP_multiroad_save_initialdata CALL EXECUTE_COMMAND_LINE (trim(command_line_zip),wait=.true.) endif - end subroutine NORTRIP_multiroad_save_initialdata \ No newline at end of file diff --git a/NORTRIP_multiroad_save_meteodata.f90 b/NORTRIP_multiroad_save_meteodata.f90 index 951ec73..e2c6058 100644 --- a/NORTRIP_multiroad_save_meteodata.f90 +++ b/NORTRIP_multiroad_save_meteodata.f90 @@ -1,32 +1,39 @@ !NORTRIP_multiroad_save_meteodata.f90 - subroutine NORTRIP_multiroad_create_meteodata +subroutine NORTRIP_multiroad_create_meteodata use NORTRIP_multiroad_index_definitions implicit none - integer i,j,t,jj,ii,j_obs,j_mod + integer i,j,t,jj,ii,r, j_obs,j_mod, road_index,surface_index, rad_index, j_forecast integer unit_in integer, allocatable :: grid_index_rl(:,:) integer, allocatable :: grid_index_rl2(:,:) + integer, allocatable :: grid_index_rl_forecast(:,:) real meteo_temp(num_var_meteo) double precision time_temp,time_temp2 integer exists - integer date_nc(num_date_index,end_dim_nc(time_index)) integer local_date_nc(num_date_index,end_dim_nc(time_index)) + integer local_date_nc_forecast(num_date_index,end_dim_nc_forecast(time_index)) integer start_time_index_nc,end_time_index_nc,hours_time_index_nc logical start_time_index_nc_found,end_time_index_nc_found + + integer start_time_index_nc_forecast,end_time_index_nc_forecast,hours_time_index_nc_forecast + logical start_time_index_nc_forecast_found,end_time_index_nc_forecast_found + integer out_of_range_count logical not_shown_once real adjust_lapse + + real :: model_at_latest_observation !! Used for in function for relaxing meteo variable when we go from observed to modeled input data + real :: latest_observation !! Used for in function for relaxing meteo variable when we go from observed to modeled input data real dist,dist_min integer i_dist_min,j_dist_min integer k real, allocatable :: dist_array_nc(:,:) real, allocatable :: dist_array_nc2(:,:) - real dgrid_lat,dgrid_lon real x_temp,y_temp real y_utm_temp,x_utm_temp @@ -39,14 +46,28 @@ subroutine NORTRIP_multiroad_create_meteodata real xpos_limit,ypos_limit logical :: show_analysis=.false. logical some_meteo_nc2_available - + logical :: print_scaling_info =.true. + integer :: latest_observation_index + integer :: latest_model + + real :: relhumidity_bias + + character(10) :: road_name + character(10) :: road_with_obs + real wetbulb_temp !Functions real DIRECTION double precision date_to_number real wetbulb_temperature - + real relax_meteo_variable_gaussian + ! integer findloc + + integer :: datetime_match !Used for matching dates with observations to the simulation date range. + + road_index=1 !Initial definition + !zip line commands !To extract !C:\Users\brucerd\Downloads\7za e -aoa NORTRIP_ALLROADS_2014110301_meteorology.zip @@ -73,6 +94,7 @@ subroutine NORTRIP_multiroad_create_meteodata !Attribute a grid index to each road link allocate (grid_index_rl(2,n_roadlinks)) allocate (grid_index_rl2(2,n_roadlinks)) + allocate (grid_index_rl_forecast(2,n_roadlinks)) allocate (dist_array_nc(dim_length_nc(x_index),dim_length_nc(y_index))) allocate (dist_array_nc2(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) @@ -117,71 +139,19 @@ subroutine NORTRIP_multiroad_create_meteodata endif !This actually means we do not have an x,y coodinate system and we 'approximate' the lat lon assuming the x,y grid is roughly in a N-S direction - elseif (index(meteo_data_type,'nbv').gt.0.or.index(meteo_data_type,'metcoop').gt.0.or.index(meteo_data_type,'emep').gt.0.or.index(meteo_data_type,'nora3').gt.0) then + elseif (index(meteo_data_type,'metcoop').gt.0.or.index(meteo_data_type,'emep').gt.0.or.index(meteo_data_type,'nora3').gt.0) then !loop through all grids to find the nearest in lat lon - !This method is very inneffective for large numbers of links. Another way must be found - !i_dist_min=0 - !j_dist_min=0 - !dist_min=1.e32 - !do ii=1,dim_length_nc(x_index) - !do jj=1,dim_length_nc(y_index) - ! dist=sqrt((var2d_nc(lat_index,ii,jj)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc(lon_index,ii,jj)*cos(var2d_nc(lat_index,ii,jj)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)*cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2) - ! if (dist.lt.dist_min) then - ! dist_min=dist - ! i_dist_min=ii - ! j_dist_min=jj - ! endif - !enddo - !enddo - - !grid_index_rl(x_index,i)=i_dist_min - !grid_index_rl(y_index,i)=j_dist_min - !write(*,*) i,grid_index_rl(x_index,i),grid_index_rl(y_index,i) - !This method is also not very efficient. Still has to find the minimum in a loop for each road - !grid_index_rl(x_index:y_index,i)=minloc((var2d_nc(lat_index,:,:)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc(lon_index,:,:)*cos(var2d_nc(lat_index,:,:)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)*cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2) - !write(*,*) k,i,grid_index_rl(x_index,i),grid_index_rl(y_index,i),110*minval(sqrt((var2d_nc(lat_index,:,:)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc(lon_index,:,:)/cos(var2d_nc(lat_index,:,:)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)/cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2)) !This method should work for any roughly north south projection but is not 'exact'. Can be out by a grid !It estimates the lat-lon grid spacing at the lat lon position with two iterations !Better would have been to do the projection but this is considered good enough and more general !Estimate the grid size of the meteo grid in lat lon by taking the central position if (meteo_nc_projection_type.eq.LCC_projection_index) then - !None of this used any more and should be deleted. Only projection at end is valid - dgrid_lat=(var2d_nc(lat_index,dim_length_nc(x_index)/2,dim_length_nc(y_index))-var2d_nc(lat_index,dim_length_nc(x_index)/2,1))/(dim_length_nc(y_index)-1) !Not used anywhere - dgrid_lon=(var2d_nc(lon_index,dim_length_nc(x_index),dim_length_nc(y_index)/2)-var2d_nc(lon_index,1,dim_length_nc(y_index)/2))/(dim_length_nc(x_index)-1) !Not used anywhere - - grid_index_rl(x_index,i)=min(dim_length_nc(x_index),max(1,1+floor((inputdata_rl(lon0_rl_index,i)-var2d_nc(lon_index,1,dim_length_nc(y_index)/2))/dgrid_lon+0.5)))!overwritten - grid_index_rl(y_index,i)=min(dim_length_nc(y_index),max(1,1+floor((inputdata_rl(lat0_rl_index,i)-var2d_nc(lat_index,grid_index_rl(x_index,i),1))/dgrid_lat+0.5)))!overwritten - grid_index_rl(x_index,i)=min(dim_length_nc(x_index),max(1,1+floor((inputdata_rl(lon0_rl_index,i)-var2d_nc(lon_index,1,grid_index_rl(y_index,i)))/dgrid_lon+0.5)))!overwritten - - !write(*,*) i,grid_index_rl(x_index,i),grid_index_rl(y_index,i),dgrid_lon,dgrid_lat - !Reestimate the lat lon grid size for the given position in the grid - dgrid_lat=(var2d_nc(lat_index,grid_index_rl(x_index,i),dim_length_nc(y_index))-var2d_nc(lat_index,grid_index_rl(x_index,i),1))/(dim_length_nc(y_index)-1) !Not used anywhere - dgrid_lon=(var2d_nc(lon_index,dim_length_nc(x_index),grid_index_rl(y_index,i))-var2d_nc(lon_index,1,grid_index_rl(y_index,i)))/(dim_length_nc(x_index)-1) !Not used anywhere - - !Recalculate position at that point - grid_index_rl(x_index,i)=min(dim_length_nc(x_index),max(1,1+floor((inputdata_rl(lon0_rl_index,i)-var2d_nc(lon_index,1,grid_index_rl(y_index,i)))/dgrid_lon+0.5))) !overwritten - grid_index_rl(y_index,i)=min(dim_length_nc(y_index),max(1,1+floor((inputdata_rl(lat0_rl_index,i)-var2d_nc(lat_index,grid_index_rl(x_index,i),1))/dgrid_lat+0.5))) !overwritten - - !write(*,*) i,grid_index_rl(x_index,i),grid_index_rl(y_index,i),dgrid_lon,dgrid_lat - !Reestimate the lat lon grid size for the given position in the grid - dgrid_lat=(var2d_nc(lat_index,grid_index_rl(x_index,i),dim_length_nc(y_index))-var2d_nc(lat_index,grid_index_rl(x_index,i),1))/(dim_length_nc(y_index)-1) !Not used anywhere - dgrid_lon=(var2d_nc(lon_index,dim_length_nc(x_index),grid_index_rl(y_index,i))-var2d_nc(lon_index,1,grid_index_rl(y_index,i)))/(dim_length_nc(x_index)-1) !Not used anywhere - - !Recalculate position at that point - x_index_temp=min(dim_length_nc(x_index),max(1,1+floor((inputdata_rl(lon0_rl_index,i)-var2d_nc(lon_index,1,grid_index_rl(y_index,i)))/dgrid_lon+0.5))) !Not used anywhere - y_index_temp=min(dim_length_nc(y_index),max(1,1+floor((inputdata_rl(lat0_rl_index,i)-var2d_nc(lat_index,grid_index_rl(x_index,i),1))/dgrid_lat+0.5))) !Not used anywhere - - !write(*,*) i,grid_index_rl(x_index,i),grid_index_rl(y_index,i),dgrid_lon,dgrid_lat - !grid_index_rl(x_index:y_index,i)=minloc((var2d_nc(lat_index,:,:)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc(lon_index,:,:)/cos(var2d_nc(lat_index,:,:)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)/cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2) - !write(*,*) 'OLD: ',i,grid_index_rl(x_index,i),grid_index_rl(y_index,i) !Project road link positions to the lambert grid call lb2lambert2_uEMEP(x_temp,y_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i),meteo_nc_projection_attributes) - else - dgrid_lat=dgrid_nc(y_index) !Not used anywhere - dgrid_lon=dgrid_nc(x_index) !Not used anywhere + else x_temp=inputdata_rl(lon0_rl_index,i) y_temp=inputdata_rl(lat0_rl_index,i) endif @@ -196,106 +166,78 @@ subroutine NORTRIP_multiroad_create_meteodata write(unit_logfile,'(a,6i)') 'WARNING: Road outside meteo grid (link_n,link_ID,grid_i,grid_j,maxgrid_i,maxgrid_j)',i,inputdata_int_rl(id_rl_index,i),grid_index_rl(x_index,i),grid_index_rl(y_index,i),dim_length_nc(x_index),dim_length_nc(y_index) endif - !Limit it to the meteo grid -1 because of the interpolation later + !Limit it to the meteo grid -1 because of the interpolation later grid_index_rl(x_index,i)=min(dim_length_nc(x_index)-1,max(2,grid_index_rl(x_index,i))) grid_index_rl(y_index,i)=min(dim_length_nc(y_index)-1,max(2,grid_index_rl(y_index,i))) - !call LL2UTM(1,utm_zone,var2d_nc(lat_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i)),var2d_nc(lon_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i)),y_utm_temp,x_utm_temp) - - !if (abs(grid_index_rl(y_index,i)-y_index_temp).ge.2.or.abs(grid_index_rl(x_index,i)-x_index_temp).ge.2) then - !write(*,*) i,grid_index_rl(x_index,i)-x_index_temp,grid_index_rl(y_index,i)-y_index_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i) - !write(*,*) x_utm_temp,y_utm_temp - !write(*,*) var1d_nc(x_index,grid_index_rl(x_index,i)),var1d_nc(y_index,grid_index_rl(y_index,i)),var1d_nc(x_index,grid_index_rl(x_index,i))-599524.,var1d_nc(y_index,grid_index_rl(y_index,i))-7593704. - !endif - !if (abs(x_utm_temp-599524.).le.dgrid_nc(x_index)*.5.and.abs(y_utm_temp-7593704.).le.dgrid_nc(y_index)*.5) then - !write(*,*) i,grid_index_rl(x_index,i)-x_index_temp,grid_index_rl(y_index,i)-y_index_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i) - !write(*,*) 'FOUND: ',x_utm_temp-599524.,y_utm_temp-7593704. - !stop - !endif - - - + + + + if (replace_meteo_with_yr.eq.1.and.some_meteo_nc2_available) then - !i_dist_min=0 - !j_dist_min=0 - !dist_min=1.e32 - !do ii=1,dim_length_nc2(x_index2) - !do jj=1,dim_length_nc2(y_index2) - ! dist=sqrt((var2d_nc2(lat_index2,ii,jj)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc2(lon_index2,ii,jj)/cos(var2d_nc2(lat_index2,ii,jj)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)/cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2) - ! if (dist.lt.dist_min) then - ! dist_min=dist - ! i_dist_min=ii - ! j_dist_min=jj - ! endif - !enddo - !enddo - - !grid_index_rl2(x_index2,i)=i_dist_min - !grid_index_rl2(y_index2,i)=j_dist_min - - !Alternative !grid_index_rl2(x_index2:y_index2,i)=minloc((var2d_nc2(lat_index2,:,:)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc2(lon_index2,:,:)/cos(var2d_nc2(lat_index2,:,:)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)/cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2) !write(*,*) k,i,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),110*minval(sqrt((var2d_nc2(lat_index2,:,:)-inputdata_rl(lat0_rl_index,i))**2+(var2d_nc2(lon_index2,:,:)/cos(var2d_nc2(lat_index2,:,:)/180.*3.14159)-inputdata_rl(lon0_rl_index,i)/cos(inputdata_rl(lat0_rl_index,i)/180.*3.14159))**2)) - if (meteo_nc_projection_type.eq.LL_projection_index) then + if (meteo_nc2_projection_type.eq.LL_projection_index) then x_temp=inputdata_rl(lon0_rl_index,i) y_temp=inputdata_rl(lat0_rl_index,i) else - call lb2lambert2_uEMEP(x_temp,y_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i),meteo_nc_projection_attributes) + call lb2lambert2_uEMEP(x_temp,y_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i),meteo_nc2_projection_attributes) endif - grid_index_rl2(x_index2,i)=1+floor((x_temp-var1d_nc2(x_index2,1))/dgrid_nc2(x_index2)+0.5) grid_index_rl2(y_index2,i)=1+floor((y_temp-var1d_nc2(y_index2,1))/dgrid_nc2(y_index2)+0.5) - - endif + + if (replace_meteo_with_met_forecast.eq.1.and.meteo_nc_forecast_available) then + + call lb2lambert2_uEMEP(x_temp,y_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i),meteo_nc_forecast_projection_attributes) + + grid_index_rl_forecast(x_index_forecast,i) = 1 + floor((x_temp-var1d_nc_forecast(x_index_forecast,1))/dgrid_nc_forecast(x_index_forecast)+0.5) + grid_index_rl_forecast(y_index_forecast,i) = 1 + floor((y_temp-var1d_nc_forecast(y_index_forecast,1))/dgrid_nc_forecast(y_index_forecast)+0.5) + + endif else write(unit_logfile,'(a,a)') ' ERROR: meteo_data_type not properly defined = ',trim(meteo_data_type) stop 24 endif - - !write(*,*) k enddo - + + if (out_of_range_count.gt.0) then - write(unit_logfile,'(a,4i12)') ' WARNING: Number of road links outside of grid (NORTRIP_multiroad_save_meteodata) = ',out_of_range_count + write(unit_logfile,'(a,4i12)') ' WARNING: Number of road links outside of grid (NORTRIP_multiroad_save_meteodata) = ',out_of_range_count endif !Match the meteo netcdf times to the input time start_time_index_nc=start_dim_nc(time_index) end_time_index_nc=end_dim_nc(time_index) - !NOTE: This is not optimal because of the round off errors. Should be relooked at - do t=start_dim_nc(time_index),end_dim_nc(time_index) - !Netcdf are in seconds since 1970 - !Round off errors in the time requires getting the value to the nearest hour - !Errors involved - - date_nc(:,t)=0 - !Calculate the day - time_temp=dble(idint(var1d_time_nc(t)/(seconds_in_hour*hours_in_day)+1./24./3600.)) !Add 1 second for round off errors - call number_to_date(time_temp,date_nc(:,t),ref_year) - !Calculate hour of the day - date_nc(hour_index,t)=idint((var1d_time_nc(t)-time_temp*dble(seconds_in_hour*hours_in_day))/dble(3600.)+.5) - - !time_temp=int(var1d_nc(time_index,t)/sngl(seconds_in_hour))/sngl(hours_in_day) - !call number_to_date(time_temp,date_nc(:,t)) - !write(*,'(i12,f24.2)') t,var1d_nc(time_index,t) - !write(*,'(i12,f16.8)') int(var1d_nc(time_index,t)/sngl(seconds_in_hour)+.5),var1d_nc(time_index,t)/sngl(seconds_in_hour) - !write(*,*) t,time_temp - !write(*,*) date_nc(:,t) + ! !NOTE: This is not optimal because of the round off errors. Should be relooked at + ! do t=start_dim_nc(time_index),end_dim_nc(time_index) + ! ! !Netcdf are in seconds since 1970 + ! ! !Round off errors in the time requires getting the value to the nearest hour + ! ! !Errors involved + + ! date_nc(:,t)=0 + ! !Calculate the day + ! time_temp=dble(idint(var1d_time_nc(t)/(seconds_in_hour*hours_in_day)+1./24./3600.)) !Add 1 second for round off errors + ! call number_to_date(time_temp,date_nc(:,t)) + ! !Calculate hour of the day + ! date_nc(hour_index,t)=idint((var1d_time_nc(t)-time_temp*dble(seconds_in_hour*hours_in_day))/dble(3600.)+.5) + + ! date_nc(minute_index,t)=idint((var1d_time_nc(t)-time_temp*dble(seconds_in_hour*hours_in_day))/dble(3600.)-time_temp*dble(60*60*24)/dble(60.) +.5) - enddo + ! enddo !Meteo data in UTC. Adjust the time stamp to local time !DIFUTC_H is UTC relative to local, so negative if local time is ahead + !TODO: can this be dropped or moved into an if test based on attributes/metadata in the netcdf file (which is from the model in this case I guess..) local_date_nc=date_nc !Do not convert meteorology to local data - do t=start_dim_nc(time_index),end_dim_nc(time_index) - !call incrtm(int(-DIFUTC_H),local_date_nc(1,t),local_date_nc(2,t),local_date_nc(3,t),local_date_nc(4,t)) - !write(*,*) local_date_nc(:,t) - enddo + ! do t=start_dim_nc(time_index),end_dim_nc(time_index) + ! !call incrtm(int(-DIFUTC_H),local_date_nc(1,t),local_date_nc(2,t),local_date_nc(3,t),local_date_nc(4,t)) + ! !write(*,*) local_date_nc(:,t) + ! enddo write(unit_logfile,'(a32,6i6)') ' Start date meteo netcdf = ',date_nc(:,start_dim_nc(time_index)) @@ -311,37 +253,90 @@ subroutine NORTRIP_multiroad_create_meteodata if (local_date_nc(year_index,t).eq.date_data(year_index,1) & .and.local_date_nc(month_index,t).eq.date_data(month_index,1) & .and.local_date_nc(day_index,t).eq.date_data(day_index,1) & - .and.local_date_nc(hour_index,t).eq.date_data(hour_index,1)) then + .and.local_date_nc(hour_index,t).eq.date_data(hour_index,1) & + .and.local_date_nc(minute_index,t).eq.date_data(minute_index,1)) then start_time_index_nc=t start_time_index_nc_found=.true. endif if (local_date_nc(year_index,t).eq.date_data(year_index,n_hours_input) & .and.local_date_nc(month_index,t).eq.date_data(month_index,n_hours_input) & .and.local_date_nc(day_index,t).eq.date_data(day_index,n_hours_input) & - .and.local_date_nc(hour_index,t).eq.date_data(hour_index,n_hours_input)) then + .and.local_date_nc(hour_index,t).eq.date_data(hour_index,n_hours_input) & + .and.local_date_nc(minute_index,t).eq.date_data(minute_index,n_hours_input)) then + end_time_index_nc=t end_time_index_nc_found=.true. endif - !write(unit_logfile,'(a32,6i6)') ' Date data = ',date_data(:,t) - !write(unit_logfile,'(a32,6i6)') ' Local data = ',local_date_nc(:,t) - enddo hours_time_index_nc=end_time_index_nc-start_time_index_nc+1 - write(unit_logfile,'(a32,i6,a32,i6,a32,i6)') ' Start_time_index_nc= ',start_time_index_nc,' End_time_index_nc= ',end_time_index_nc,' Hours_nc= ',hours_time_index_nc + write(unit_logfile,'(a32,i6,a32,i6,a32,i6)') ' Start_time_index_nc= ',start_time_index_nc,' End_time_index_nc= ',end_time_index_nc,' timesteps nc= ',hours_time_index_nc if (start_time_index_nc.ne.2) then !write(*,'(A,I)') 'Wrong nc start index. Stopping: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',start_time_index_nc !stop endif - - + + if (.not.start_time_index_nc_found.or..not.end_time_index_nc_found) then write(*,'(A)') ' ERROR: Input time start or stop date not found in meteo data. Stopping' write(unit_logfile,'(a32,6i6)') ' Start date input = ',start_date_input write(unit_logfile,'(a32,6i6)') ' End date input = ',end_date_input - !write(*,*) start_time_index_nc_found,end_time_index_nc_found,n_hours_input stop 25 endif + + !---------------------------------------------------MET Nordic forecast stuff-------------------------------------------------------------------------------! + if ( replace_meteo_with_met_forecast.eq.1 .and. meteo_nc_forecast_available) then + + + !Match the meteo netcdf times to the input time + start_time_index_nc_forecast=start_dim_nc_forecast(time_index) + end_time_index_nc_forecast=end_dim_nc_forecast(time_index) + + local_date_nc_forecast=date_nc_forecast + + write(unit_logfile,'(a40,6i6)') ' Start date forecast meteo netcdf = ',date_nc_forecast(:,start_dim_nc_forecast(time_index)) + write(unit_logfile,'(a40,6i6)') ' End date forecast meteo netcdf = ' ,date_nc_forecast(:,end_dim_nc_forecast(time_index)) + write(unit_logfile,'(a40,6i6)') ' Start date forecast meteo local = ' ,local_date_nc_forecast(:,start_dim_nc_forecast(time_index)) + write(unit_logfile,'(a40,6i6)') ' End date forecast meteo local = ' ,local_date_nc_forecast(:,end_dim_nc_forecast(time_index)) + + !Find starting and finishing index + + start_time_index_nc_forecast_found=.false. + end_time_index_nc_forecast_found=.false. + do t=start_dim_nc_forecast(time_index),end_dim_nc_forecast(time_index) + if (local_date_nc_forecast(year_index,t).eq.date_data(year_index,1) & + .and.local_date_nc_forecast(month_index,t).eq.date_data(month_index,1) & + .and.local_date_nc_forecast(day_index,t).eq.date_data(day_index,1) & + .and.local_date_nc_forecast(hour_index,t).eq.date_data(hour_index,1) & + .and.local_date_nc_forecast(minute_index,t).eq.date_data(minute_index,1)) then + + start_time_index_nc_forecast=t + start_time_index_nc_forecast_found=.true. + endif + if (local_date_nc_forecast(year_index,t).eq.date_data(year_index,n_hours_input) & + .and.local_date_nc_forecast(month_index,t).eq.date_data(month_index,n_hours_input) & + .and.local_date_nc_forecast(day_index,t).eq.date_data(day_index,n_hours_input) & + .and.local_date_nc_forecast(hour_index,t).eq.date_data(hour_index,n_hours_input) & + .and.local_date_nc_forecast(minute_index,t).eq.date_data(minute_index,n_hours_input)) then + + + end_time_index_nc_forecast=t + end_time_index_nc_forecast_found=.true. + endif + enddo + hours_time_index_nc=end_time_index_nc_forecast-start_time_index_nc_forecast+1 + write(unit_logfile,'(a32,i6,a32,i6,a32,i6)') ' Start_time_index_nc_forecast= ',start_time_index_nc_forecast,' End_time_index_nc_forecast= ',end_time_index_nc_forecast,' timesteps nc= ',hours_time_index_nc + + + + if (.not.start_time_index_nc_forecast_found.or..not.end_time_index_nc_forecast_found) then + write(*,'(A)') ' ERROR: Input time start or stop date not found in forecast meteo data. Stopping' + write(unit_logfile,'(a32,6i6)') ' Start date input = ',start_date_input + write(unit_logfile,'(a32,6i6)') ' End date input = ',end_date_input + !stop 25 + endif + end if + !------------------------------------------------------------------------------------------------------------------------------------------------! not_shown_once=.true. @@ -353,402 +348,592 @@ subroutine NORTRIP_multiroad_create_meteodata if (replace_meteo_with_yr.eq.1.and..not.some_meteo_nc2_available) then write(unit_logfile,'(a)') 'No analysis meteo data available at all. Will not replace' endif + + if (replace_meteo_with_met_forecast.eq.1.and.meteo_nc_forecast_available) then + write(unit_logfile,'(a)') 'Replacing model meteorology with met forecast data (arome,forecast)' + endif + if (meteo_obs_data_available) then write(unit_logfile,'(a)') 'Replacing model values with observations (model,obs)' write(unit_logfile,'(10a20)') 'Temperature','Wind speed','Wind direction','Humidity','Precipitation','Shortwave','Longwave','Pressure','Surface_temperature','T_adjust_lapse' endif - - -!Distribute meteo data to roadlinks. Saves all links or specified links. + + !Distribute meteo data to roadlinks. Saves all links or specified links. do j=1,n_save_links i=save_links(j) - - if ((inputdata_int_rl(savedata_rl_index,i).eq.1.and.use_only_special_links_flag.ge.1) & - .or.(use_only_special_links_flag.eq.0).or.(use_only_special_links_flag.eq.2)) then - - !write(unit_logfile,'(a)') trim(meteo_obs_name(ii)) - - do t=1,n_hours_input - !do t=start_time_index_nc,end_time_index_nc - j_mod=start_time_index_nc+t-1 - j_obs=start_time_index_meteo_obs+t-1 - j_obs=t - !write(*,*) n_hours_input,start_time_index_nc,t,j_mod - !write(*,'(5i)') i,grid_index_rl(x_index,i),grid_index_rl(y_index,i),dim_length_nc(x_index),dim_length_nc(y_index) - !time_temp=var1d_time_nc(j_mod) !Not used here as this is the time stamp - meteo_temp(temperature_index)=var3d_nc(temperature_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-273.15 - meteo_temp(speed_wind_index)=sqrt(var3d_nc(x_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)**2 & - + var3d_nc(y_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)**2) - meteo_temp(dir_wind_index)=DIRECTION(var3d_nc(x_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) & - ,var3d_nc(y_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) - meteo_temp(relhumidity_index)=var3d_nc(relhumidity_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)*100. - if (.not.var_available_nc(precip_snow_index)) then - meteo_temp(precip_index)=max(0.,var3d_nc(precip_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) - if (meteo_temp(temperature_index).gt.0) then - meteo_temp(rain_index)=meteo_temp(precip_index) - meteo_temp(snow_index)=0 - else - meteo_temp(rain_index)=0 - meteo_temp(snow_index)=meteo_temp(precip_index) - endif - else - meteo_temp(precip_index)=max(0.,var3d_nc(precip_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) !Not used but calculated - meteo_temp(rain_index)=max(0.,var3d_nc(precip_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod))-max(0.,var3d_nc(precip_snow_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) - meteo_temp(snow_index)=max(0.,var3d_nc(precip_snow_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) - endif - meteo_temp(shortwaveradiation_index)=var3d_nc(shortwaveradiation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) - meteo_temp(longwaveradiation_index)=var3d_nc(longwaveradiation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) - meteo_temp(cloudfraction_index)=var3d_nc(cloudfraction_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) - meteo_temp(road_temperature_index)=var3d_nc(surface_temperature_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-273.15 - !meteo_temp(road_temperature_index)=missing_data - !EMEP meteo data is in hPa but meps is in Pa - if (index(meteo_data_type,'emep').gt.0) then - meteo_temp(pressure_index)=var3d_nc(pressure_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) - else - meteo_temp(pressure_index)=var3d_nc(pressure_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)/100. - endif - - - !Bilineal interpolation, which is the same as an area weighted interpolation - if (interpolate_meteo_data) then - - !Size of grid - xpos_limit=dgrid_nc(x_index)/2. - ypos_limit=dgrid_nc(y_index)/2. - - !Index of nearest neighbour meteo grid - i_nc=grid_index_rl(x_index,i) - j_nc=grid_index_rl(y_index,i) - - !Position of centre of road link - if (meteo_nc_projection_type.eq.LL_projection_index) then - x_temp=inputdata_rl(lon0_rl_index,i) - y_temp=inputdata_rl(lat0_rl_index,i) - else - call lb2lambert2_uEMEP(x_temp,y_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i),meteo_nc_projection_attributes) - endif + .or.(use_only_special_links_flag.eq.0).or.(use_only_special_links_flag.eq.2)) then - xpos_area_max=x_temp+xpos_limit - xpos_area_min=x_temp-xpos_limit - ypos_area_max=y_temp+ypos_limit - ypos_area_min=y_temp-ypos_limit - - sum_weighting_nc=0 - !write(*,'(2i,f12.4,5f12.4)') i,j_mod,sum_weighting_nc,meteo_temp(temperature_index),meteo_temp(speed_wind_index),meteo_temp(dir_wind_index),meteo_temp(shortwaveradiation_index),meteo_temp(rain_index) - meteo_temp=0. - - !Loop over the nearest grids to finding area weighting - do jj=j_nc-1,j_nc+1 - do ii=i_nc-1,i_nc+1 - - xpos_min=max(xpos_area_min,var1d_nc(x_index,ii)-xpos_limit) - xpos_max=min(xpos_area_max,var1d_nc(x_index,ii)+xpos_limit) - ypos_min=max(ypos_area_min,var1d_nc(y_index,jj)-ypos_limit) - ypos_max=min(ypos_area_max,var1d_nc(y_index,jj)+ypos_limit) - - !write(*,*) ii,jj - !write(*,*) 'MIN1 : ',xpos_min,xpos_max,ypos_min,ypos_max - !write(*,*) 'MIN2:',var1d_nc(x_index,ii)-xpos_limit,var1d_nc(x_index,ii)+xpos_limit,var1d_nc(y_index,jj)-ypos_limit,var1d_nc(y_index,jj)+ypos_limit - !write(*,*) 'AREA: ',xpos_area_min,xpos_area_max,ypos_area_min,ypos_area_max - - !Determine the area intersection of the meteo grid and a meteo grid size centred on the road link - if (xpos_max.gt.xpos_min.and.ypos_max.gt.ypos_min) then - weighting_nc=(ypos_max-ypos_min)*(xpos_max-xpos_min)/dgrid_nc(x_index)/dgrid_nc(y_index) - else - weighting_nc=0. - endif - sum_weighting_nc=sum_weighting_nc+weighting_nc - - !write(*,*) ii-i_nc,jj-j_nc,weighting_nc + do t=1,hours_time_index_nc - meteo_temp(temperature_index)=meteo_temp(temperature_index)+(var3d_nc(temperature_index,ii,jj,j_mod)-273.15)*weighting_nc - meteo_temp(x_wind_index)=meteo_temp(x_wind_index)+var3d_nc(x_wind_index,ii,jj,j_mod)*weighting_nc - meteo_temp(y_wind_index)=meteo_temp(y_wind_index)+var3d_nc(y_wind_index,ii,jj,j_mod)*weighting_nc - meteo_temp(relhumidity_index)=meteo_temp(relhumidity_index)+var3d_nc(relhumidity_index,ii,jj,j_mod)*100.*weighting_nc + !do t=start_time_index_nc,end_time_index_nc + j_mod=start_time_index_nc+t-1 + j_obs=start_time_index_meteo_obs+t-1 + j_obs=t + meteo_temp(temperature_index)=var3d_nc(temperature_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-273.15 + meteo_temp(speed_wind_index)=sqrt(var3d_nc(x_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)**2 & + + var3d_nc(y_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)**2) + meteo_temp(dir_wind_index)=DIRECTION(var3d_nc(x_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) & + ,var3d_nc(y_wind_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) !TODO: General check of the input data to find if this conversion is needed or not. + meteo_temp(relhumidity_index)=var3d_nc(relhumidity_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)*100. if (.not.var_available_nc(precip_snow_index)) then - meteo_temp(precip_index)=meteo_temp(precip_index)+max(0.,var3d_nc(precip_index,ii,jj,j_mod))*weighting_nc + meteo_temp(precip_index)=max(0.,var3d_nc(precip_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) + if (meteo_temp(temperature_index).gt.0) then + meteo_temp(rain_index)=meteo_temp(precip_index) + meteo_temp(snow_index)=0 + else + meteo_temp(rain_index)=0 + meteo_temp(snow_index)=meteo_temp(precip_index) + endif else - meteo_temp(precip_index)=meteo_temp(precip_index)+max(0.,var3d_nc(precip_index,ii,jj,j_mod))*weighting_nc !Not used but calculated - meteo_temp(rain_index)=meteo_temp(rain_index) & - +(max(0.,var3d_nc(precip_index,ii,jj,j_mod)) & - -max(0.,var3d_nc(precip_snow_index,ii,jj,j_mod)))*weighting_nc - meteo_temp(snow_index)=meteo_temp(snow_index)+max(0.,var3d_nc(precip_snow_index,ii,jj,j_mod))*weighting_nc + meteo_temp(precip_index)=max(0.,var3d_nc(precip_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) !Not used but calculated + meteo_temp(rain_index)=max(0.,var3d_nc(precip_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod))-max(0.,var3d_nc(precip_snow_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) + meteo_temp(snow_index)=max(0.,var3d_nc(precip_snow_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)) endif + meteo_temp(shortwaveradiation_index)=var3d_nc(shortwaveradiation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) + meteo_temp(longwaveradiation_index)=var3d_nc(longwaveradiation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) + meteo_temp(cloudfraction_index)=var3d_nc(cloudfraction_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) + !meteo_temp(road_temperature_index)=var3d_nc(surface_temperature_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-273.15 + ! Do not use modeled surface temperature data. + meteo_temp(road_temperature_index)=missing_data - meteo_temp(shortwaveradiation_index)=meteo_temp(shortwaveradiation_index)+var3d_nc(shortwaveradiation_index,ii,jj,j_mod)*weighting_nc - meteo_temp(longwaveradiation_index)=meteo_temp(longwaveradiation_index)+var3d_nc(longwaveradiation_index,ii,jj,j_mod)*weighting_nc - meteo_temp(cloudfraction_index)=meteo_temp(cloudfraction_index)+var3d_nc(cloudfraction_index,ii,jj,j_mod)*weighting_nc - meteo_temp(pressure_index)=meteo_temp(pressure_index)+var3d_nc(pressure_index,ii,jj,j_mod)/100.*weighting_nc - meteo_temp(road_temperature_index)=meteo_temp(road_temperature_index)+(var3d_nc(surface_temperature_index,ii,jj,j_mod)-273.15)*weighting_nc - - enddo - enddo + !EMEP meteo data is in hPa but meps is in Pa + if (index(meteo_data_type,'emep').gt.0) then + meteo_temp(pressure_index)=var3d_nc(pressure_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod) + else + meteo_temp(pressure_index)=var3d_nc(pressure_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)/100. + endif + + !Bilineal interpolation, which is the same as an area weighted interpolation + if (interpolate_meteo_data) then + + !Size of grid + xpos_limit=dgrid_nc(x_index)/2. + ypos_limit=dgrid_nc(y_index)/2. + + !Index of nearest neighbour meteo grid + i_nc=grid_index_rl(x_index,i) + j_nc=grid_index_rl(y_index,i) - meteo_temp(speed_wind_index)=sqrt(meteo_temp(x_wind_index)**2+meteo_temp(y_wind_index)**2) - meteo_temp(dir_wind_index)=DIRECTION(meteo_temp(x_wind_index),meteo_temp(y_wind_index)) - if (.not.var_available_nc(precip_snow_index)) then - wetbulb_temp=meteo_temp(temperature_index) - if (wetbulb_snow_rain_flag.eq.0) then - if (meteo_temp(temperature_index).gt.0) then - meteo_temp(rain_index)=meteo_temp(precip_index) - meteo_temp(snow_index)=0 - else - meteo_temp(rain_index)=0 - meteo_temp(snow_index)=meteo_temp(precip_index) - endif - elseif (wetbulb_snow_rain_flag.eq.1) then - call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + !Position of centre of road link + if (meteo_nc_projection_type.eq.LL_projection_index) then + x_temp=inputdata_rl(lon0_rl_index,i) + y_temp=inputdata_rl(lat0_rl_index,i) else - wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) - call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + call lb2lambert2_uEMEP(x_temp,y_temp,inputdata_rl(lon0_rl_index,i),inputdata_rl(lat0_rl_index,i),meteo_nc_projection_attributes) endif - if (meteo_temp(precip_index).gt.0.and.1.eq.2) then - write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) - write(*,*) wetbulb_temp,meteo_temp(precip_index),meteo_temp(rain_index),meteo_temp(snow_index) - endif - - endif - - !write(*,'(2i,f12.4,5f12.4)') i,j_mod,sum_weighting_nc,meteo_temp(temperature_index),meteo_temp(speed_wind_index),meteo_temp(dir_wind_index),meteo_temp(shortwaveradiation_index),meteo_temp(rain_index) - endif !interpolate_meteo_data - - !Should I use t or j_mod here? Use t since the correct hour is placed in t - if (replace_meteo_with_yr.eq.1) then - if (meteo_nc2_available(t)) then - if (not_shown_once.and.show_analysis) then - write(unit_logfile,'(a,i,f10.3,f10.3)') 'Temperature: ',t,meteo_temp(temperature_index),var3d_nc2(temperature_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)-273.15 - write(unit_logfile,'(a,i,f10.3,f10.3)') 'Rel humidity: ',t,meteo_temp(relhumidity_index),var3d_nc2(relhumidity_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)*100. - write(unit_logfile,'(a,i,f10.3,f10.3)') 'Wind speed: ',t,meteo_temp(speed_wind_index),sqrt(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2 & - + var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2) - write(unit_logfile,'(a,i,f10.3,f10.3)') 'Wind direct :',t,meteo_temp(dir_wind_index),DIRECTION(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) & - ,var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) - write(unit_logfile,'(a,i,f10.3,f10.3)') 'Precipitation:',t,meteo_temp(precip_index),max(0.,var3d_nc2(precip_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) - endif - - if (meteo_var_nc2_available(t,temperature_index2)) then - meteo_temp(temperature_index)=var3d_nc2(temperature_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)-273.15 - endif - - if (meteo_var_nc2_available(t,x_wind_index2).and.meteo_var_nc2_available(t,y_wind_index2)) then - meteo_temp(speed_wind_index)=sqrt(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2 & - + var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2) - meteo_temp(dir_wind_index)=DIRECTION(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) & - ,var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) - endif - - if (meteo_var_nc2_available(t,speed_wind_index2).and.meteo_var_nc2_available(t,dir_wind_index2)) then - meteo_temp(speed_wind_index)=var3d_nc2(speed_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) - meteo_temp(dir_wind_index)=var3d_nc2(dir_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) - endif - - if (meteo_var_nc2_available(t,relhumidity_index2)) then - meteo_temp(relhumidity_index)=var3d_nc2(relhumidity_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)*100. - endif - - if (meteo_var_nc2_available(t,precip_index2)) then - meteo_temp(precip_index)=max(0.,var3d_nc2(precip_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) - wetbulb_temp=meteo_temp(temperature_index) - if (wetbulb_snow_rain_flag.eq.0) then - if (meteo_temp(temperature_index).gt.0) then - meteo_temp(rain_index)=meteo_temp(precip_index) - meteo_temp(snow_index)=0 + + xpos_area_max=x_temp+xpos_limit + xpos_area_min=x_temp-xpos_limit + ypos_area_max=y_temp+ypos_limit + ypos_area_min=y_temp-ypos_limit + + sum_weighting_nc=0 + !write(*,'(2i,f12.4,5f12.4)') i,j_mod,sum_weighting_nc,meteo_temp(temperature_index),meteo_temp(speed_wind_index),meteo_temp(dir_wind_index),meteo_temp(shortwaveradiation_index),meteo_temp(rain_index) + meteo_temp=0. + + !Loop over the nearest grids to finding area weighting + do jj=j_nc-1,j_nc+1 + do ii=i_nc-1,i_nc+1 + + xpos_min=max(xpos_area_min,var1d_nc(x_index,ii)-xpos_limit) + xpos_max=min(xpos_area_max,var1d_nc(x_index,ii)+xpos_limit) + ypos_min=max(ypos_area_min,var1d_nc(y_index,jj)-ypos_limit) + ypos_max=min(ypos_area_max,var1d_nc(y_index,jj)+ypos_limit) + + !write(*,*) ii,jj + !write(*,*) 'MIN1 : ',xpos_min,xpos_max,ypos_min,ypos_max + !write(*,*) 'MIN2:',var1d_nc(x_index,ii)-xpos_limit,var1d_nc(x_index,ii)+xpos_limit,var1d_nc(y_index,jj)-ypos_limit,var1d_nc(y_index,jj)+ypos_limit + !write(*,*) 'AREA: ',xpos_area_min,xpos_area_max,ypos_area_min,ypos_area_max + + !Determine the area intersection of the meteo grid and a meteo grid size centred on the road link + if (xpos_max.gt.xpos_min.and.ypos_max.gt.ypos_min) then + weighting_nc=(ypos_max-ypos_min)*(xpos_max-xpos_min)/dgrid_nc(x_index)/dgrid_nc(y_index) + else + weighting_nc=0. + endif + sum_weighting_nc=sum_weighting_nc+weighting_nc + + !write(*,*) ii-i_nc,jj-j_nc,weighting_nc + + meteo_temp(temperature_index)=meteo_temp(temperature_index)+(var3d_nc(temperature_index,ii,jj,j_mod)-273.15)*weighting_nc + meteo_temp(x_wind_index)=meteo_temp(x_wind_index)+var3d_nc(x_wind_index,ii,jj,j_mod)*weighting_nc + meteo_temp(y_wind_index)=meteo_temp(y_wind_index)+var3d_nc(y_wind_index,ii,jj,j_mod)*weighting_nc + meteo_temp(relhumidity_index)=meteo_temp(relhumidity_index)+var3d_nc(relhumidity_index,ii,jj,j_mod)*100.*weighting_nc + + if (.not.var_available_nc(precip_snow_index)) then + meteo_temp(precip_index)=meteo_temp(precip_index)+max(0.,var3d_nc(precip_index,ii,jj,j_mod))*weighting_nc + else + meteo_temp(precip_index)=meteo_temp(precip_index)+max(0.,var3d_nc(precip_index,ii,jj,j_mod))*weighting_nc !Not used but calculated + meteo_temp(rain_index)=meteo_temp(rain_index) & + +(max(0.,var3d_nc(precip_index,ii,jj,j_mod)) & + -max(0.,var3d_nc(precip_snow_index,ii,jj,j_mod)))*weighting_nc + meteo_temp(snow_index)=meteo_temp(snow_index)+max(0.,var3d_nc(precip_snow_index,ii,jj,j_mod))*weighting_nc + endif + + meteo_temp(shortwaveradiation_index)=meteo_temp(shortwaveradiation_index)+var3d_nc(shortwaveradiation_index,ii,jj,j_mod)*weighting_nc + meteo_temp(longwaveradiation_index)=meteo_temp(longwaveradiation_index)+var3d_nc(longwaveradiation_index,ii,jj,j_mod)*weighting_nc + meteo_temp(cloudfraction_index)=meteo_temp(cloudfraction_index)+var3d_nc(cloudfraction_index,ii,jj,j_mod)*weighting_nc + meteo_temp(pressure_index)=meteo_temp(pressure_index)+var3d_nc(pressure_index,ii,jj,j_mod)/100.*weighting_nc + meteo_temp(road_temperature_index)=missing_data !meteo_temp(road_temperature_index)+(var3d_nc(surface_temperature_index,ii,jj,j_mod)-273.15)*weighting_nc + + enddo + enddo + + meteo_temp(speed_wind_index)=sqrt(meteo_temp(x_wind_index)**2+meteo_temp(y_wind_index)**2) + meteo_temp(dir_wind_index)=DIRECTION(meteo_temp(x_wind_index),meteo_temp(y_wind_index)) + if (.not.var_available_nc(precip_snow_index)) then + wetbulb_temp=meteo_temp(temperature_index) + if (wetbulb_snow_rain_flag.eq.0) then + if (meteo_temp(temperature_index).gt.0) then + meteo_temp(rain_index)=meteo_temp(precip_index) + meteo_temp(snow_index)=0 + else + meteo_temp(rain_index)=0 + meteo_temp(snow_index)=meteo_temp(precip_index) + endif + elseif (wetbulb_snow_rain_flag.eq.1) then + call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) else - meteo_temp(rain_index)=0 - meteo_temp(snow_index)=meteo_temp(precip_index) + wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) + call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) endif - elseif (wetbulb_snow_rain_flag.eq.1) then - call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) - else - wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) - call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + if (meteo_temp(precip_index).gt.0.and.1.eq.2) then + write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) + write(*,*) wetbulb_temp,meteo_temp(precip_index),meteo_temp(rain_index),meteo_temp(snow_index) + endif + endif - if (meteo_temp(precip_index).gt.0.and.1.eq.2) then - write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) - write(*,*) wetbulb_temp,meteo_temp(precip_index),meteo_temp(rain_index),meteo_temp(snow_index) - endif + endif !interpolate_meteo_data - endif - - if (meteo_var_nc2_available(t,cloudfraction_index2)) then - meteo_temp(cloudfraction_index)=var3d_nc2(cloudfraction_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) - endif - - endif - endif - - !Replace the data with observed meteo data. The same for all roads except for temperature lapse rate - if (meteo_obs_data_available.and.replace_meteo_with_obs.eq.1) then - !ii=save_meteo_index(j) !Was jj - ii=1 - if (not_shown_once) then - !Adjusts the common observed temperature to the model height (assumes model height is correct) - adjust_lapse=(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,ii))*lapse_rate - write(unit_logfile,'(18f10.1,f10.3)') meteo_temp(temperature_index),meteo_obs_data_final(temperature_index,j_obs)+adjust_lapse & - ,meteo_temp(speed_wind_index),meteo_obs_data_final(speed_wind_index,j_obs) & - ,meteo_temp(dir_wind_index),meteo_obs_data_final(dir_wind_index,j_obs) & - ,meteo_temp(relhumidity_index),meteo_obs_data_final(relhumidity_index,j_obs) & - ,meteo_temp(precip_index),meteo_obs_data_final(precip_index,j_obs) & - ,meteo_temp(shortwaveradiation_index),meteo_obs_data_final(shortwaveradiation_index,j_obs) & - ,meteo_temp(longwaveradiation_index),meteo_obs_data_final(longwaveradiation_index,j_obs) & - ,meteo_temp(pressure_index),meteo_obs_data_final(pressure_index,j_obs) & - ,meteo_temp(road_temperature_index),meteo_obs_data_final(road_temperature_index,j_obs) & - ,adjust_lapse - endif - - if (meteo_obs_data_final(temperature_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(temperature_index).gt.0) then - meteo_temp(temperature_index)=meteo_obs_data_final(temperature_index,j_obs) & - +(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,1))*lapse_rate - endif - if (meteo_obs_data_final(road_temperature_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(road_temperature_index).gt.0) then - meteo_temp(road_temperature_index)=meteo_obs_data_final(road_temperature_index,j_obs) & - +(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,1))*lapse_rate - endif - if (meteo_obs_data_final(speed_wind_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(speed_wind_index).gt.0) meteo_temp(speed_wind_index)=meteo_obs_data_final(speed_wind_index,j_obs) - if (meteo_obs_data_final(dir_wind_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(dir_wind_index).gt.0) meteo_temp(dir_wind_index)=meteo_obs_data_final(dir_wind_index,j_obs) - if (meteo_obs_data_final(relhumidity_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(relhumidity_index).gt.0) meteo_temp(relhumidity_index)=meteo_obs_data_final(relhumidity_index,j_obs) - if (meteo_obs_data_final(shortwaveradiation_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(shortwaveradiation_index).gt.0) meteo_temp(shortwaveradiation_index)=meteo_obs_data_final(shortwaveradiation_index,j_obs) - if (meteo_obs_data_final(longwaveradiation_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(longwaveradiation_index).gt.0) meteo_temp(longwaveradiation_index)=meteo_obs_data_final(longwaveradiation_index,j_obs) - if (meteo_obs_data_final(cloudfraction_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(cloudfraction_index).gt.0) meteo_temp(cloudfraction_index)=meteo_obs_data_final(cloudfraction_index,j_obs)/8. - if (meteo_obs_data_final(pressure_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(pressure_index).gt.0) meteo_temp(pressure_index)=meteo_obs_data_final(pressure_index,j_obs) - if (meteo_obs_data_final(precip_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(precip_index).gt.0) then - !if (meteo_temp(temperature_index).gt.0) then - ! meteo_temp(rain_index)=meteo_obs_data_final(precip_index,j_obs) - ! meteo_temp(snow_index)=0 - !else - ! meteo_temp(rain_index)=0 - ! meteo_temp(snow_index)=meteo_obs_data_final(precip_index,j_obs) - !endif - - wetbulb_temp=meteo_temp(temperature_index) - if (wetbulb_snow_rain_flag.eq.0) then - if (meteo_temp(temperature_index).gt.0) then - meteo_temp(rain_index)=meteo_obs_data_final(precip_index,j_obs) - meteo_temp(snow_index)=0 - else - meteo_temp(rain_index)=0 - meteo_temp(snow_index)=meteo_obs_data_final(precip_index,j_obs) + + not_shown_once=.false. + if (replace_meteo_with_met_forecast.eq.1 .and. meteo_nc_forecast_available) then + j_forecast = start_time_index_nc_forecast+t-1 !! Index counter for the array containing forecast meteo data + + if (meteo_nc_forecast_available) then + if (not_shown_once) then + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Temperature: ',t,meteo_temp(temperature_index),var3d_nc_forecast(temperature_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t)-273.15 + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Rel humidity: ',t,meteo_temp(relhumidity_index),var3d_nc_forecast(relhumidity_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t)*100. + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Precipitation:',t,meteo_temp(precip_index),max(0.,var3d_nc_forecast(precip_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t)) + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Wind speed:',t,meteo_temp(speed_wind_index),var3d_nc_forecast(speed_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t) + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Wind direction:',t,meteo_temp(dir_wind_index),var3d_nc_forecast(dir_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t) + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Longwave: ',t,meteo_temp(longwaveradiation_index),var3d_nc_forecast(longwaveradiation_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t) + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Shortwave: ',t,meteo_temp(shortwaveradiation_index),var3d_nc_forecast(shortwaveradiation_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),t) + endif + + if (meteo_var_nc_forecast_available(t,temperature_index_forecast)) then + meteo_temp(temperature_index)=var3d_nc_forecast(temperature_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast)-273.15 + endif + + if (meteo_var_nc_forecast_available(t,speed_wind_index_forecast).and.meteo_var_nc_forecast_available(t,speed_wind_index_forecast)) then + meteo_temp(speed_wind_index)=var3d_nc_forecast(speed_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast) + endif + + if (meteo_var_nc_forecast_available(t,speed_wind_index_forecast).and.meteo_var_nc_forecast_available(t,dir_wind_index_forecast)) then + meteo_temp(speed_wind_index)=var3d_nc_forecast(speed_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast) + meteo_temp(dir_wind_index)=var3d_nc_forecast(dir_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast) + endif + + if (meteo_var_nc_forecast_available(t,relhumidity_index_forecast)) then + meteo_temp(relhumidity_index)=var3d_nc_forecast(relhumidity_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast)*100. + endif + + if (meteo_var_nc_forecast_available(t,longwaveradiation_index_forecast)) then + meteo_temp(longwaveradiation_index)=var3d_nc_forecast(longwaveradiation_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast) + endif + + if (meteo_var_nc_forecast_available(t,shortwaveradiation_index_forecast)) then + meteo_temp(shortwaveradiation_index)=var3d_nc_forecast(shortwaveradiation_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),j_forecast) + endif + + + + if (meteo_var_nc_forecast_available(t,precip_index_forecast)) then + + wetbulb_temp=meteo_temp(temperature_index) + if (wetbulb_snow_rain_flag.eq.0) then + if (meteo_temp(temperature_index).gt.0) then + meteo_temp(rain_index)=meteo_temp(precip_index) + meteo_temp(snow_index)=0 + else + meteo_temp(rain_index)=0 + meteo_temp(snow_index)=meteo_temp(precip_index) + endif + elseif (wetbulb_snow_rain_flag.eq.1) then + call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + else + wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) + call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + endif + if (meteo_temp(precip_index).gt.0.and.1.eq.2) then + write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) + write(*,*) wetbulb_temp,meteo_temp(precip_index),meteo_temp(rain_index),meteo_temp(snow_index) + endif endif - elseif (wetbulb_snow_rain_flag.eq.1) then - call distribute_rain_snow(wetbulb_temp,meteo_obs_data_final(precip_index,j_obs),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) - else - wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) - call distribute_rain_snow(wetbulb_temp,meteo_obs_data_final(precip_index,j_obs),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) endif - if (meteo_temp(precip_index).gt.0.and.1.eq.2) then - write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) - write(*,*) wetbulb_temp,meteo_obs_data_final(precip_index,j_obs),meteo_temp(rain_index),meteo_temp(snow_index) - endif - endif - - !Possible to remove these four data sources - if (replace_which_meteo_with_obs(shortwaveradiation_index).lt.0) meteo_temp(shortwaveradiation_index)=missing_data - if (replace_which_meteo_with_obs(longwaveradiation_index).lt.0) meteo_temp(longwaveradiation_index)=missing_data - if (replace_which_meteo_with_obs(cloudfraction_index).lt.0) meteo_temp(cloudfraction_index)=missing_data - if (replace_which_meteo_with_obs(road_temperature_index).lt.0) meteo_temp(road_temperature_index)=missing_data - endif - - !Replacing at individual stations - if (meteo_obs_data_available.and.replace_meteo_with_obs.eq.2) then - ii=save_meteo_index(j) !Was jj - !Adjusts the model temperature according to lapse rate so it fits to the observation height. Only does this if replace_meteo_with_obs.eq.2 + endif + + !Should I use t or j_mod here? Use t since the correct hour is placed in t if (replace_meteo_with_yr.eq.1) then - adjust_lapse=(var2d_nc2(elevation_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i))-meteo_obs_position(meteo_obs_height_index,ii))*lapse_rate - else - adjust_lapse=(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,ii))*lapse_rate - endif - meteo_temp(temperature_index)=meteo_temp(temperature_index)+adjust_lapse - if (not_shown_once) then - write(unit_logfile,'(18f10.1,f10.3)') meteo_temp(temperature_index)+adjust_lapse,meteo_obs_data(temperature_index,j_obs,ii) & - ,meteo_temp(speed_wind_index),meteo_obs_data(speed_wind_index,j_obs,ii) & - ,meteo_temp(dir_wind_index),meteo_obs_data(dir_wind_index,j_obs,ii) & - ,meteo_temp(relhumidity_index),meteo_obs_data(relhumidity_index,j_obs,ii) & - ,meteo_temp(precip_index),meteo_obs_data(precip_index,j_obs,ii) & - ,meteo_temp(shortwaveradiation_index),meteo_obs_data(shortwaveradiation_index,j_obs,ii) & - ,meteo_temp(longwaveradiation_index),meteo_obs_data(longwaveradiation_index,j_obs,ii) & - ,meteo_temp(pressure_index),meteo_obs_data(pressure_index,j_obs,ii) & - ,meteo_temp(road_temperature_index),meteo_obs_data(road_temperature_index,j_obs,ii) & - ,adjust_lapse - endif - - if (meteo_obs_data(temperature_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(temperature_index).gt.0) meteo_temp(temperature_index)=meteo_obs_data(temperature_index,j_obs,ii) - if (meteo_obs_data(dir_wind_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(dir_wind_index).gt.0) meteo_temp(dir_wind_index)=meteo_obs_data(dir_wind_index,j_obs,ii) - if (meteo_obs_data(speed_wind_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(speed_wind_index).gt.0) meteo_temp(speed_wind_index)=meteo_obs_data(speed_wind_index,j_obs,ii) - if (meteo_obs_data(relhumidity_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(relhumidity_index).gt.0) meteo_temp(relhumidity_index)=meteo_obs_data(relhumidity_index,j_obs,ii) - if (meteo_obs_data(precip_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(precip_index).gt.0) then + if (meteo_nc2_available(t)) then + if (not_shown_once.and.show_analysis) then + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Temperature: ',t,meteo_temp(temperature_index),var3d_nc2(temperature_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)-273.15 + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Rel humidity: ',t,meteo_temp(relhumidity_index),var3d_nc2(relhumidity_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)*100. + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Wind speed: ',t,meteo_temp(speed_wind_index),sqrt(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2 & + + var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2) + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Wind direct :',t,meteo_temp(dir_wind_index),DIRECTION(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) & + ,var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) + write(unit_logfile,'(a,i,f10.3,f10.3)') 'Precipitation:',t,meteo_temp(precip_index),max(0.,var3d_nc2(precip_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) + endif + + if (meteo_var_nc2_available(t,temperature_index2)) then + meteo_temp(temperature_index)=var3d_nc2(temperature_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)-273.15 + endif + + if (meteo_var_nc2_available(t,x_wind_index2).and.meteo_var_nc2_available(t,y_wind_index2)) then + meteo_temp(speed_wind_index)=sqrt(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2 & + + var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)**2) + meteo_temp(dir_wind_index)=DIRECTION(var3d_nc2(x_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) & + ,var3d_nc2(y_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) + endif + + if (meteo_var_nc2_available(t,speed_wind_index2).and.meteo_var_nc2_available(t,dir_wind_index2)) then + meteo_temp(speed_wind_index)=var3d_nc2(speed_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) + meteo_temp(dir_wind_index)=var3d_nc2(dir_wind_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) + endif + + if (meteo_var_nc2_available(t,relhumidity_index2)) then + meteo_temp(relhumidity_index)=var3d_nc2(relhumidity_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)*100. + endif + + if (meteo_var_nc2_available(t,precip_index2)) then + meteo_temp(precip_index)=max(0.,var3d_nc2(precip_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t)) + wetbulb_temp=meteo_temp(temperature_index) + if (wetbulb_snow_rain_flag.eq.0) then + if (meteo_temp(temperature_index).gt.0) then + meteo_temp(rain_index)=meteo_temp(precip_index) + meteo_temp(snow_index)=0 + else + meteo_temp(rain_index)=0 + meteo_temp(snow_index)=meteo_temp(precip_index) + endif + elseif (wetbulb_snow_rain_flag.eq.1) then + call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + else + wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) + call distribute_rain_snow(wetbulb_temp,meteo_temp(precip_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + endif + if (meteo_temp(precip_index).gt.0.and.1.eq.2) then + write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) + write(*,*) wetbulb_temp,meteo_temp(precip_index),meteo_temp(rain_index),meteo_temp(snow_index) + endif + endif + + if (meteo_var_nc2_available(t,cloudfraction_index2)) then + meteo_temp(cloudfraction_index)=var3d_nc2(cloudfraction_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i),t) + endif + endif + endif + + !Replace the data with observed meteo data. The same for all roads except for temperature lapse rate + if (meteo_obs_data_available.and.replace_meteo_with_obs.eq.1) then + !ii=save_meteo_index(j) !Was jj + ii=1 + if (not_shown_once) then + !Adjusts the common observed temperature to the model height (assumes model height is correct) + adjust_lapse=(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,ii))*lapse_rate + write(unit_logfile,'(18f10.1,f10.3)') meteo_temp(temperature_index),meteo_obs_data_final(temperature_index,j_obs)+adjust_lapse & + ,meteo_temp(speed_wind_index),meteo_obs_data_final(speed_wind_index,j_obs) & + ,meteo_temp(dir_wind_index),meteo_obs_data_final(dir_wind_index,j_obs) & + ,meteo_temp(relhumidity_index),meteo_obs_data_final(relhumidity_index,j_obs) & + ,meteo_temp(precip_index),meteo_obs_data_final(precip_index,j_obs) & + ,meteo_temp(shortwaveradiation_index),meteo_obs_data_final(shortwaveradiation_index,j_obs) & + ,meteo_temp(longwaveradiation_index),meteo_obs_data_final(longwaveradiation_index,j_obs) & + ,meteo_temp(pressure_index),meteo_obs_data_final(pressure_index,j_obs) & + ,meteo_temp(road_temperature_index),meteo_obs_data_final(road_temperature_index,j_obs) & + ,adjust_lapse + endif - !if (meteo_temp(temperature_index).gt.0) then - ! meteo_temp(rain_index)=meteo_obs_data(precip_index,j_obs,ii) - ! meteo_temp(snow_index)=0 - !else - ! meteo_temp(rain_index)=0 - ! meteo_temp(snow_index)=meteo_obs_data(precip_index,j_obs,ii) - !endif - - wetbulb_temp=meteo_temp(temperature_index) - if (wetbulb_snow_rain_flag.eq.0) then - if (meteo_temp(temperature_index).gt.0) then - meteo_temp(rain_index)=meteo_obs_data(precip_index,j_obs,ii) - meteo_temp(snow_index)=0 + if (meteo_obs_data_final(temperature_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(temperature_index).gt.0) then + meteo_temp(temperature_index)=meteo_obs_data_final(temperature_index,j_obs) & + +(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,1))*lapse_rate + endif + if (meteo_obs_data_final(road_temperature_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(road_temperature_index).gt.0) then + meteo_temp(road_temperature_index)=meteo_obs_data_final(road_temperature_index,j_obs) & + +(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,1))*lapse_rate + endif + if (meteo_obs_data_final(speed_wind_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(speed_wind_index).gt.0) meteo_temp(speed_wind_index)=meteo_obs_data_final(speed_wind_index,j_obs) + if (meteo_obs_data_final(dir_wind_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(dir_wind_index).gt.0) meteo_temp(dir_wind_index)=meteo_obs_data_final(dir_wind_index,j_obs) + if (meteo_obs_data_final(relhumidity_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(relhumidity_index).gt.0) meteo_temp(relhumidity_index)=meteo_obs_data_final(relhumidity_index,j_obs) + if (meteo_obs_data_final(shortwaveradiation_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(shortwaveradiation_index).gt.0) meteo_temp(shortwaveradiation_index)=meteo_obs_data_final(shortwaveradiation_index,j_obs) + if (meteo_obs_data_final(longwaveradiation_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(longwaveradiation_index).gt.0) meteo_temp(longwaveradiation_index)=meteo_obs_data_final(longwaveradiation_index,j_obs) + if (meteo_obs_data_final(cloudfraction_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(cloudfraction_index).gt.0) meteo_temp(cloudfraction_index)=meteo_obs_data_final(cloudfraction_index,j_obs)/8. + if (meteo_obs_data_final(pressure_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(pressure_index).gt.0) meteo_temp(pressure_index)=meteo_obs_data_final(pressure_index,j_obs) + + if (meteo_obs_data_final(precip_index,j_obs).ne.missing_data.and.replace_which_meteo_with_obs(precip_index).gt.0) then + + wetbulb_temp=meteo_temp(temperature_index) + if (wetbulb_snow_rain_flag.eq.0) then + if (meteo_temp(temperature_index).gt.0) then + meteo_temp(rain_index)=meteo_obs_data_final(precip_index,j_obs) + meteo_temp(snow_index)=0 + else + meteo_temp(rain_index)=0 + meteo_temp(snow_index)=meteo_obs_data_final(precip_index,j_obs) + endif + elseif (wetbulb_snow_rain_flag.eq.1) then + call distribute_rain_snow(wetbulb_temp,meteo_obs_data_final(precip_index,j_obs),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) else - meteo_temp(rain_index)=0 - meteo_temp(snow_index)=meteo_obs_data(precip_index,j_obs,ii) + wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) + call distribute_rain_snow(wetbulb_temp,meteo_obs_data_final(precip_index,j_obs),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) endif - elseif (wetbulb_snow_rain_flag.eq.1) then - call distribute_rain_snow(wetbulb_temp,meteo_obs_data(precip_index,j_obs,ii),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) - else - wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) - call distribute_rain_snow(wetbulb_temp,meteo_obs_data(precip_index,j_obs,ii),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) - endif - if (meteo_temp(precip_index).gt.0.and.1.eq.2) then - write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) - write(*,*) wetbulb_temp,meteo_obs_data(precip_index,j_obs,ii),meteo_temp(rain_index),meteo_temp(snow_index) - endif + if (meteo_temp(precip_index).gt.0.and.1.eq.2) then + write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) + write(*,*) wetbulb_temp,meteo_obs_data_final(precip_index,j_obs),meteo_temp(rain_index),meteo_temp(snow_index) + endif + endif + !Possible to remove these four data sources + if (replace_which_meteo_with_obs(shortwaveradiation_index).lt.0) meteo_temp(shortwaveradiation_index)=missing_data + if (replace_which_meteo_with_obs(longwaveradiation_index).lt.0) meteo_temp(longwaveradiation_index)=missing_data + if (replace_which_meteo_with_obs(cloudfraction_index).lt.0) meteo_temp(cloudfraction_index)=missing_data + if (replace_which_meteo_with_obs(road_temperature_index).lt.0) meteo_temp(road_temperature_index)=missing_data endif + !Replacing at individual stations + if (meteo_obs_data_available.and.replace_meteo_with_obs.eq.2) then + if (print_scaling_info) then + if ( scaling_for_relaxation .ne. 0 ) then + write(*,'(A,I2,A)') "Will replace modeled data with observations from stations where available." + write(*,'(A,I2,A)') "Relaxing variables from observed to modeled values, with a scaling time of ",int(scaling_for_relaxation)," hours." + else + write(*,*) "WARNING: Do not relax variables when jumping from observations to modeled meteorology." + end if + print_scaling_info = .false. + end if + + !Check if there are observations available in the date range of the simulation. + datetime_match = findloc(obs_exist,t,dim=1) !Look for match among the observations + + if ( datetime_match.ne. 0 ) then + + road_name = trim(inputdata_char_rl(roadname_rl_index,i)) !Model road + + if ( t .eq. obs_exist(1) ) then !Printing + if ( any(index(meteo_obs_name,road_name(1:5)) > 0) ) then + not_shown_once = .true. + write(*,'(A,A,A,I7)') "Replace modeled with observed meteorology from station ", trim(road_name(1:5)), " for road link with ID ",inputdata_int_rl(id_rl_index,i) + + else + write(*,'(A,I7,A,A,A)') "WARNING: No observational data found for road link ", inputdata_int_rl(id_rl_index,i), ". Using observational data from station ", road_name(1:5)//"0", " if available." + end if + end if + + surface_index = 0 + road_index = 0 + rad_index = 0 + do r = 1, size(meteo_obs_name) !! Loop through the roads with observations to find matches between road links and observations + road_with_obs = trim(meteo_obs_name(r)) + if ( road_name(1:5) == road_with_obs(1:5) ) then + road_index = findloc(meteo_obs_name, road_name(1:5)//"0",dim=1) !! Replace meteorology with data from the default station ("0") + rad_index = road_index + if ( road_name(6:7) == "1" ) then + surface_index = findloc(meteo_obs_name, road_name(1:5)//"1",dim=1) + + if ( road_name(1:5) =="50500" ) then !Fix to read radiation from station 50500:1 for Flesland + rad_index = surface_index + end if + + else if ( road_name(6:7) == "2" ) then + surface_index = findloc(meteo_obs_name, road_name(1:5)//"2",dim=1) + else + surface_index = road_index + end if + end if + end do + !NOTE: if surface_index or road_index is 0, it means that there is no observational data for that station. In that case, the values are not replaced. + !Adjusts the model temperature according to lapse rate so it fits to the observation height. Only does this if replace_meteo_with_obs.eq.2. !TODO This only affect the printing? + ! if (replace_meteo_with_yr.eq.1) then + ! adjust_lapse=(var2d_nc2(elevation_index2,grid_index_rl2(x_index2,i),grid_index_rl2(y_index2,i))-meteo_obs_position(meteo_obs_height_index,road_index))*lapse_rate + ! else + ! adjust_lapse=(var3d_nc(elevation_index,grid_index_rl(x_index,i),grid_index_rl(y_index,i),j_mod)-meteo_obs_position(meteo_obs_height_index,road_index))*lapse_rate + ! endif + + !meteo_temp(temperature_index)=meteo_temp(temperature_index)+adjust_lapse + if (not_shown_once .and. road_index.ne.0 .and. surface_index.ne.0) then + !NOTE: These are written regardless of the conditions used to determine if the values should actually be changed or not! + write(unit_logfile,'(18f10.1,f10.3)') meteo_temp(temperature_index)+adjust_lapse,meteo_obs_data(temperature_index,datetime_match,road_index) & + ,meteo_temp(speed_wind_index),meteo_obs_data(speed_wind_index,datetime_match,road_index) & + ,meteo_temp(dir_wind_index),meteo_obs_data(dir_wind_index,datetime_match,road_index) & + ,meteo_temp(relhumidity_index),meteo_obs_data(relhumidity_index,datetime_match,road_index) & + ,meteo_temp(precip_index),meteo_obs_data(precip_index,datetime_match,road_index) & + ,meteo_temp(shortwaveradiation_index),meteo_obs_data(shortwaveradiation_index,datetime_match,rad_index) & + ,meteo_temp(longwaveradiation_index),meteo_obs_data(longwaveradiation_index,datetime_match,rad_index) & + ,meteo_temp(pressure_index),meteo_obs_data(pressure_index,datetime_match,road_index) & + ,meteo_temp(road_temperature_index),meteo_obs_data(road_temperature_index,datetime_match,surface_index) & + ,adjust_lapse + not_shown_once = .false. + endif + + if ( road_index.ne.0 ) then + + if ( t .eq. maxval(obs_exist) ) then !Save the indicies if we are at the latest observational timestep. This is used for relaxation. + latest_observation_index = datetime_match + + if ( replace_meteo_with_met_forecast.eq.1 .and. meteo_nc_forecast_available ) then + latest_model = j_forecast + else + latest_model = j_mod + end if + if (meteo_obs_data(relhumidity_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(relhumidity_index).gt.0) then + relhumidity_bias = meteo_temp(relhumidity_index) - meteo_obs_data(relhumidity_index,datetime_match,road_index) + endif + end if + + if (meteo_obs_data(temperature_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(temperature_index).gt.0) then + meteo_temp(temperature_index)=meteo_obs_data(temperature_index,datetime_match,road_index) + endif + if (meteo_obs_data(dir_wind_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(dir_wind_index).gt.0) meteo_temp(dir_wind_index)=meteo_obs_data(dir_wind_index,datetime_match,road_index) + if (meteo_obs_data(speed_wind_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(speed_wind_index).gt.0) meteo_temp(speed_wind_index)=meteo_obs_data(speed_wind_index,datetime_match,road_index) + if (meteo_obs_data(relhumidity_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(relhumidity_index).gt.0) meteo_temp(relhumidity_index)=meteo_obs_data(relhumidity_index,datetime_match,road_index) + + if (meteo_obs_data(precip_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(precip_index).gt.0) then + + wetbulb_temp=meteo_temp(temperature_index) + if (wetbulb_snow_rain_flag.eq.0) then + if (meteo_temp(temperature_index).gt.0) then + meteo_temp(rain_index)=meteo_obs_data(precip_index,datetime_match,road_index) + meteo_temp(snow_index)=0 + else + meteo_temp(rain_index)=0 + meteo_temp(snow_index)=meteo_obs_data(precip_index,datetime_match,road_index) + endif + elseif (wetbulb_snow_rain_flag.eq.1) then + call distribute_rain_snow(wetbulb_temp,meteo_obs_data(precip_index,datetime_match,road_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + else + wetbulb_temp=wetbulb_temperature(meteo_temp(temperature_index),meteo_temp(pressure_index)*100.,meteo_temp(relhumidity_index)) + call distribute_rain_snow(wetbulb_temp,meteo_obs_data(precip_index,datetime_match,road_index),wetbulb_snow_rain_flag,meteo_temp(rain_index),meteo_temp(snow_index)) + endif + if (meteo_temp(precip_index).gt.0.and.1.eq.2) then + write(*,*) wetbulb_temp,meteo_temp(temperature_index),meteo_temp(pressure_index),meteo_temp(relhumidity_index) + write(*,*) wetbulb_temp,meteo_obs_data(precip_index,datetime_match,road_index),meteo_temp(rain_index),meteo_temp(snow_index) + endif + + endif + + if (meteo_obs_data(cloudfraction_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(cloudfraction_index).gt.0 .and.road_index.ne.0) meteo_temp(cloudfraction_index)=meteo_obs_data(cloudfraction_index,datetime_match,road_index) + if (meteo_obs_data(pressure_index,datetime_match,road_index).ne.missing_data.and.replace_which_meteo_with_obs(pressure_index).gt.0 .and.road_index.ne.0) meteo_temp(pressure_index)=meteo_obs_data(pressure_index,datetime_match,road_index) + + end if + + + if ( rad_index.ne.0 ) then + if (meteo_obs_data(shortwaveradiation_index,datetime_match,rad_index).ne.missing_data.and.replace_which_meteo_with_obs(shortwaveradiation_index).gt.0 .and. meteo_obs_data(shortwaveradiation_index,datetime_match,rad_index).ge.0) meteo_temp(shortwaveradiation_index)=meteo_obs_data(shortwaveradiation_index,datetime_match,rad_index) + if (meteo_obs_data(longwaveradiation_index,datetime_match,rad_index).ne.missing_data.and.replace_which_meteo_with_obs(longwaveradiation_index).gt.0 ) meteo_temp(longwaveradiation_index)=meteo_obs_data(longwaveradiation_index,datetime_match,rad_index) + end if + + if ( surface_index.ne.0 ) then + if (meteo_obs_data(road_temperature_index,datetime_match,surface_index).ne.missing_data.and.replace_which_meteo_with_obs(road_temperature_index).gt.0) meteo_temp(road_temperature_index)=meteo_obs_data(road_temperature_index,datetime_match,surface_index) + end if + !When replacing road surface temperature with obs then include the no data values. This is mostly for the forecast initialisation + ! if (replace_which_meteo_with_obs(road_temperature_index).gt.0) meteo_temp(road_temperature_index)=meteo_obs_data(road_temperature_index,datetime_match,road_index) + + !Possible to remove these four data sources + if (replace_which_meteo_with_obs(shortwaveradiation_index).lt.0) meteo_temp(shortwaveradiation_index)=missing_data + if (replace_which_meteo_with_obs(longwaveradiation_index).lt.0) meteo_temp(longwaveradiation_index)=missing_data + if (replace_which_meteo_with_obs(cloudfraction_index).lt.0) meteo_temp(cloudfraction_index)=missing_data + if (replace_which_meteo_with_obs(road_temperature_index).lt.0) meteo_temp(road_temperature_index)=missing_data + + end if + ! !-------------- Relax meteo variables NB: currently only works with "replace_meteo_with_met_forecast.eq.1" ------------------------------- + if (scaling_for_relaxation .ne. 0 .and. replace_meteo_with_obs.eq.2 .and. t > maxval(obs_exist) .and. replace_meteo_with_met_forecast.eq.1 .and. meteo_nc_forecast_available .and. road_index.ne.0 ) then ! t is higher than the highest timestep with observations (This assumes that the obs array starts at the first timestep)!TODO: Make it possible to also relax regular arome data. + !Temperature + latest_observation = meteo_obs_data(temperature_index,latest_observation_index,road_index) + model_at_latest_observation = var3d_nc_forecast(temperature_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),latest_model)-273.15 + + if ( latest_observation .ne. missing_data ) then + meteo_temp(temperature_index)= relax_meteo_variable_gaussian(meteo_temp(temperature_index), model_at_latest_observation, latest_observation, t-maxval(obs_exist) ,timestep,scaling_for_relaxation) + end if + + !Longwave + latest_observation = meteo_obs_data(longwaveradiation_index, latest_observation_index, road_index) + model_at_latest_observation = var3d_nc_forecast(longwaveradiation_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),latest_model) + + if ( latest_observation .ne. missing_data ) then + meteo_temp(longwaveradiation_index)= relax_meteo_variable_gaussian(meteo_temp(longwaveradiation_index), model_at_latest_observation, latest_observation, t-maxval(obs_exist) ,timestep,scaling_for_relaxation) + end if + + !Shortwave + latest_observation = meteo_obs_data(shortwaveradiation_index, latest_observation_index, road_index) + model_at_latest_observation = var3d_nc_forecast(shortwaveradiation_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),latest_model) + + if ( latest_observation .ne. missing_data ) then + meteo_temp(shortwaveradiation_index)= relax_meteo_variable_gaussian(meteo_temp(shortwaveradiation_index), model_at_latest_observation, latest_observation, t-maxval(obs_exist) ,timestep,scaling_for_relaxation) + end if + + ! !Relative Humidity + meteo_temp(relhumidity_index)=min(meteo_temp(relhumidity_index)-relhumidity_bias,100.) + !Pressure + latest_observation = meteo_obs_data(pressure_index, latest_observation_index, road_index) + + model_at_latest_observation = var3d_nc_forecast(pressure_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),latest_model)/100. + + if ( latest_observation .ne. missing_data ) then + meteo_temp(pressure_index)= relax_meteo_variable_gaussian(meteo_temp(pressure_index), model_at_latest_observation, latest_observation, t-maxval(obs_exist) ,timestep,scaling_for_relaxation) + end if + + + !wind direction + latest_observation = meteo_obs_data(dir_wind_index, latest_observation_index, road_index) + + model_at_latest_observation = var3d_nc_forecast(dir_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),latest_model) - if (meteo_obs_data(shortwaveradiation_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(shortwaveradiation_index).gt.0) meteo_temp(shortwaveradiation_index)=meteo_obs_data(shortwaveradiation_index,j_obs,ii) - if (meteo_obs_data(longwaveradiation_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(longwaveradiation_index).gt.0) meteo_temp(longwaveradiation_index)=meteo_obs_data(longwaveradiation_index,j_obs,ii) - if (meteo_obs_data(cloudfraction_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(cloudfraction_index).gt.0) meteo_temp(cloudfraction_index)=meteo_obs_data(cloudfraction_index,j_obs,ii) - if (meteo_obs_data(pressure_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(pressure_index).gt.0) meteo_temp(pressure_index)=meteo_obs_data(pressure_index,j_obs,ii) - !if (meteo_obs_data(road_temperature_index,j_obs,ii).ne.missing_data.and.replace_which_meteo_with_obs(road_temperature_index).gt.0) meteo_temp(road_temperature_index)=meteo_obs_data(road_temperature_index,j_obs,ii) - !When replacing road surface temperature with obs then include the no data values. This is mostly for the forecast initialisation - if (replace_which_meteo_with_obs(road_temperature_index).gt.0) meteo_temp(road_temperature_index)=meteo_obs_data(road_temperature_index,j_obs,ii) - - !Possible to remove these four data sources - if (replace_which_meteo_with_obs(shortwaveradiation_index).lt.0) meteo_temp(shortwaveradiation_index)=missing_data - if (replace_which_meteo_with_obs(longwaveradiation_index).lt.0) meteo_temp(longwaveradiation_index)=missing_data - if (replace_which_meteo_with_obs(cloudfraction_index).lt.0) meteo_temp(cloudfraction_index)=missing_data - if (replace_which_meteo_with_obs(road_temperature_index).lt.0) meteo_temp(road_temperature_index)=missing_data - endif + if ( latest_observation .ne. missing_data ) then + meteo_temp(dir_wind_index)= relax_meteo_variable_gaussian(meteo_temp(dir_wind_index), model_at_latest_observation, latest_observation, t-maxval(obs_exist) ,timestep,scaling_for_relaxation) + end if + !wind speed + latest_observation = meteo_obs_data(speed_wind_index, latest_observation_index, road_index) + + model_at_latest_observation = var3d_nc_forecast(speed_wind_index_forecast,grid_index_rl_forecast(x_index_forecast,i),grid_index_rl_forecast(y_index_forecast,i),latest_model) + + if ( latest_observation .ne. missing_data ) then + meteo_temp(speed_wind_index)= relax_meteo_variable_gaussian(meteo_temp(speed_wind_index), model_at_latest_observation, latest_observation, t-maxval(obs_exist) ,timestep,scaling_for_relaxation) + end if - if (meteo_obs_data_available) then - meteo_obs_ID_output(i)=meteo_obs_ID(ii) - else - meteo_obs_ID_output(i)=0 - endif - meteo_output(temperature_index,t,i)=meteo_temp(temperature_index) - meteo_output(speed_wind_index,t,i)=meteo_temp(speed_wind_index) - meteo_output(dir_wind_index,t,i)=meteo_temp(dir_wind_index) - meteo_output(relhumidity_index,t,i)=meteo_temp(relhumidity_index) - meteo_output(rain_index,t,i)=meteo_temp(rain_index) - meteo_output(snow_index,t,i)=meteo_temp(snow_index) - meteo_output(shortwaveradiation_index,t,i)=meteo_temp(shortwaveradiation_index) - meteo_output(longwaveradiation_index,t,i)=meteo_temp(longwaveradiation_index) - meteo_output(cloudfraction_index,t,i)=meteo_temp(cloudfraction_index) - meteo_output(pressure_index,t,i)=meteo_temp(pressure_index) - meteo_output(road_temperature_index,t,i)=meteo_temp(road_temperature_index) - - enddo - not_shown_once=.false. + end if + !-------------------------------------------------------------------- + + endif + + !TODO: 'meteo_obs_ID_output' is only used for writing in the subroutine 'NORTRIP_multiroad_save_meteodata', which is only used if NORTRIP_preprocessor_combined_flag is false (i.e. almost never?). + !For this if-test to work when reading multiple station data from netcdf, the 'meteo_obs_data_available' should be an array with one value for each station. + !if (meteo_obs_data_available) then + ! meteo_obs_ID_output(i)=meteo_obs_ID(j) + !else + meteo_obs_ID_output(i)=0 + !endif + meteo_output(temperature_index,t,i)=meteo_temp(temperature_index) + meteo_output(speed_wind_index,t,i)= meteo_temp(speed_wind_index) + meteo_output(dir_wind_index,t,i)=meteo_temp(dir_wind_index) + meteo_output(relhumidity_index,t,i)=meteo_temp(relhumidity_index) + meteo_output(rain_index,t,i)=meteo_temp(rain_index) + meteo_output(snow_index,t,i)=meteo_temp(snow_index) + meteo_output(shortwaveradiation_index,t,i)=meteo_temp(shortwaveradiation_index) + meteo_output(longwaveradiation_index,t,i)=meteo_temp(longwaveradiation_index) + meteo_output(cloudfraction_index,t,i)=meteo_temp(cloudfraction_index) + meteo_output(pressure_index,t,i)=meteo_temp(pressure_index) + meteo_output(road_temperature_index,t,i)=meteo_temp(road_temperature_index) + enddo !time + not_shown_once=.false. + endif + enddo - - + deallocate (grid_index_rl) deallocate (dist_array_nc) deallocate (dist_array_nc2) @@ -761,9 +946,9 @@ subroutine NORTRIP_multiroad_create_meteodata if (allocated(var3d_nc2)) deallocate (var3d_nc2) - end subroutine NORTRIP_multiroad_create_meteodata +end subroutine NORTRIP_multiroad_create_meteodata - subroutine NORTRIP_multiroad_save_meteodata +subroutine NORTRIP_multiroad_save_meteodata use NORTRIP_multiroad_index_definitions @@ -774,9 +959,9 @@ subroutine NORTRIP_multiroad_save_meteodata logical exists - write(unit_logfile,'(A)') '================================================================' - write(unit_logfile,'(A)') 'Saving multiroad meteorology file (NORTRIP_multiroad_save_meteodata)' - write(unit_logfile,'(A)') '================================================================' + write(unit_logfile,'(A)') '================================================================' + write(unit_logfile,'(A)') 'Saving multiroad meteorology file (NORTRIP_multiroad_save_meteodata)' + write(unit_logfile,'(A)') '================================================================' !pathname_meteo='C:\BEDRE BYLUFT\NORTRIP implementation\test_output\'; !filename_meteo='NORTRIP_test'//'_meteorology.txt' @@ -809,10 +994,10 @@ subroutine NORTRIP_multiroad_save_meteodata 'Rain',achar(9),'Snow',achar(9),'Global radiation',achar(9),'Longwave radiation',achar(9),'Cloud cover',achar(9),'Pressure',achar(9),'Road surface temperature' -!Distribute meteo data to roadlinks. Saves all links or specified links. + !Distribute meteo data to roadlinks. Saves all links or specified links. do jj=1,n_save_links i=save_links(jj) - + if ((inputdata_int_rl(savedata_rl_index,i).eq.1.and.use_only_special_links_flag.ge.1) & .or.(use_only_special_links_flag.eq.0).or.(use_only_special_links_flag.eq.2)) then @@ -861,5 +1046,5 @@ subroutine NORTRIP_multiroad_save_meteodata endif if (allocated(meteo_output)) deallocate (meteo_output) - - end subroutine NORTRIP_multiroad_save_meteodata + +end subroutine NORTRIP_multiroad_save_meteodata diff --git a/NORTRIP_read_analysismeteo_netcdf4.f90 b/NORTRIP_read_analysismeteo_netcdf4.f90 new file mode 100644 index 0000000..6ad21bb --- /dev/null +++ b/NORTRIP_read_analysismeteo_netcdf4.f90 @@ -0,0 +1,261 @@ + + subroutine NORTRIP_read_analysismeteo_netcdf4 + !Reads yr temperature 66 hour forecast data + + use NORTRIP_multiroad_index_definitions + !Update to netcdf 4 and 64 bit in this version 2 of NORTRIP_read_t2m500yr_netcdf + use netcdf + + implicit none + + !include 'netcdf.inc' + + !Local variables + integer status_nc2 !Error message + integer id_nc2 + integer dim_id_nc2(num_dims_nc2) + integer xtype_nc2(num_var_nc2) + integer natts_nc2(num_var_nc2) + integer var_id_nc2(num_var_nc2) + integer dim_length_metcoop_nc2(num_dims_nc2+1) + integer dim_start_metcoop_nc2(num_dims_nc2+1) + + character(256) dimname_temp + integer i + integer i_grid_mid,j_grid_mid + real dlat_nc2 + integer exists + integer ii,jj,tt,t + + integer var_id_nc2_projection + character(256) pathname_nc2_in,filename_nc2_in + integer new_start_date_input(num_date_index) + double precision temp_date + double precision date_to_number + + double precision, allocatable :: var2d_nc2_dp(:,:) + double precision, allocatable :: var3d_nc2_dp(:,:) + + logical dim_read_flag + + !Local variables used in the Avinor case: + integer,dimension(1) :: f + integer,dimension(1) :: l + integer :: first_value + integer :: last_value + + write(unit_logfile,'(A)') '================================================================' + write(unit_logfile,'(A)') 'Reading additional meteorological data (NORTRIP_read_analysismeteo_netcdf4)' + write(unit_logfile,'(A)') '================================================================' + + pathfilename_nc2=trim(pathname_nc2)//trim(filename_nc2) + pathname_nc2_in=pathname_nc2 + filename_nc2_in=filename_nc2_template + new_start_date_input=start_date_input + + if (.not.allocated(meteo_nc2_available)) allocate (meteo_nc2_available(n_hours_input)) + if (.not.allocated(meteo_var_nc2_available)) allocate (meteo_var_nc2_available(n_hours_input,num_var_nc2)) + meteo_var_nc2_available=.true. + + dim_read_flag=.false. + + !Loop through the number of time steps and read in data when available + do t=1,int(n_hours_input) + temp_date=date_to_number(start_date_input, ref_year) + call number_to_date(temp_date+(t-1)/dble(24.*timesteps_in_hour),new_start_date_input,ref_year) + if (new_start_date_input(minute_index) == 0) then !Only look for files at whole hours + + call date_to_datestr_bracket(new_start_date_input,filename_nc2_in,filename_nc2) + call date_to_datestr_bracket(new_start_date_input,pathname_nc2_in,pathname_nc2) + pathfilename_nc2=trim(pathname_nc2)//trim(filename_nc2) + + !Test existence of the filename. If does not exist then skip the time index + inquire(file=trim(pathfilename_nc2),exist=exists) + if (.not.exists) then + write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf2 file does not exist: ', trim(pathfilename_nc2) + meteo_nc2_available(t)=.false. + else + write(unit_logfile,'(a,7i)') 'Date array: ',t,new_start_date_input(1:6) + meteo_nc2_available(t)=.true. + endif + else + meteo_nc2_available(t)=.false. + endif + + !Open the netcdf file for reading + if (meteo_nc2_available(t)) then + + write(unit_logfile,'(2A)') ' Opening netcdf meteo file: ',trim(pathfilename_nc2) + status_nc2 = NF90_OPEN (pathfilename_nc2, NF90_NOWRITE, id_nc2) + if (status_nc2 .NE. NF90_NOERR) write(unit_logfile,'(A,I)') 'ERROR opening netcdf file: ',status_nc2 + + !Find the projection. If no projection then in lat lon coordinates + status_nc2 = NF90_INQ_VARID (id_nc2,trim(projection_name_nc2),var_id_nc2_projection) + + if (status_nc2.eq.NF90_NOERR) then + !If there is a projection then read in the attributes. All these are doubles + !status_nc = nf90_inquire_variable(id_nc, var_id_nc_projection, natts = numAtts_projection) + status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'standard_parallel', meteo_nc2_projection_attributes(1:2)) + status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'longitude_of_central_meridian', meteo_nc2_projection_attributes(3)) + status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'latitude_of_projection_origin', meteo_nc2_projection_attributes(4)) + status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'earth_radius', meteo_nc2_projection_attributes(5)) + meteo_nc2_projection_type=LCC_projection_index + write(unit_logfile,'(A,5f12.2)') 'Reading lambert_conformal_conic projection. ',meteo_nc2_projection_attributes(1:5) + else + meteo_nc2_projection_type=LL_projection_index + endif + + if (.not.dim_read_flag) then + !Find out the x,y and time dimmensions of the file + status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(x_index2),dim_id_nc2(x_index2)) + status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(x_index2),dimname_temp,dim_length_nc2(x_index2)) + status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(y_index2),dim_id_nc2(y_index2)) + status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(y_index2),dimname_temp,dim_length_nc2(y_index2)) + + call NORTRIP_reduce_meteo_region2(id_nc2) + dim_read_flag=.true. + endif + status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(time_index2),dim_id_nc2(time_index2)) + status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(time_index2),dimname_temp,dim_length_nc2(time_index2)) + write(unit_logfile,'(A,3I)') ' Size of dimensions (x,y,t): ',dim_length_nc2 + + if (number_of_time_steps.ne.0) then + dim_length_nc2(time_index)=number_of_time_steps + write(unit_logfile,'(A,3I)') ' WARNING: Reducing dimensions of (t) to save space: ',dim_length_nc2(time_index) + endif + + !Allocate the nc arrays for reading + if (.not.allocated(var1d_nc2)) allocate (var1d_nc2(num_dims_nc2,maxval(dim_length_nc2))) !x and y and time maximum dimensions + if (.not.allocated(var3d_nc2)) allocate (var3d_nc2(num_var_nc2,dim_length_nc2(x_index2),dim_length_nc2(y_index2),n_hours_input)) + if (.not.allocated(var2d_nc2)) allocate (var2d_nc2(num_var_nc2,dim_length_nc2(x_index2),dim_length_nc2(y_index2))) !Lat and lon and elevation + if (.not.allocated(var3d_nc2_dp)) allocate (var3d_nc2_dp(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) + if (.not.allocated(var2d_nc2_dp)) allocate (var2d_nc2_dp(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) !Lat and lon + + !Set the number of hours to be read + + !Read the x, y and time values + do i=1,num_dims_nc2 + status_nc2 = NF90_INQ_VARID (id_nc2, trim(dim_name_nc2(i)), var_id_nc2(i)) + !status_nc2 = NF_GET_VARA_REAL (id_nc2, var_id_nc2(i), dim_start_nc2(i), dim_length_nc2(i), var1d_nc2(i,:)) + status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var1d_nc2(i,1:dim_length_nc2(i)), start=(/dim_start_nc2(i)/), count=(/dim_length_nc2(i)/)) + if (i.eq.time_index2) then + write(unit_logfile,'(3A,2i12)') ' ',trim(dim_name_nc2(i)),' (min, max in hours): ' & + ,minval(int((var1d_nc2(i,1:dim_length_nc2(i))-var1d_nc2(i,dim_start_nc2(i)))/3600.+.5)+1) & + ,maxval(int((var1d_nc2(i,1:dim_length_nc2(i))-var1d_nc2(i,dim_start_nc2(i)))/3600.+.5)+1) + else + write(unit_logfile,'(3A,2f12.2)') ' ',trim(dim_name_nc2(i)),' (min, max in km): ' & + ,minval(var1d_nc2(i,1:dim_length_nc2(i))),maxval(var1d_nc2(i,1:dim_length_nc2(i))) + endif + + enddo + + + !Read through the variables in a loop + do i=1,num_var_nc2 + + status_nc2 = NF90_INQ_VARID (id_nc2, trim(var_name_nc2(i)), var_id_nc2(i)) + + if (status_nc2.eq.NF90_NOERR) then + if (i.eq.lat_index2.or.i.eq.lon_index2) then + + status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var2d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/)); + var2d_nc2(i,:,:)=real(var2d_nc2_dp) + write(unit_logfile,'(A,i3,2A,2f16.4)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & + ,minval(var2d_nc2(i,:,:)),maxval(var2d_nc2(i,:,:)) + + elseif (i.eq.elevation_index2) then + + status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var2d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/)); + var2d_nc2(i,:,:)=real(var2d_nc2_dp) + write(unit_logfile,'(A,i3,2A,2f16.4)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & + ,minval(var2d_nc2(i,:,:)),maxval(var2d_nc2(i,:,:)) + + else + !Due to memory problems must loop through time on this variable + !do t=1,dim_length_nc2(time_index2) + dim_start_nc2(time_index2)=1 + dim_length_nc2(time_index2)=1 + status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var3d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/)); + var3d_nc2(i,:,:,t)=real(var3d_nc2_dp) + !enddo + dim_start_nc2(time_index2)=1 + dim_length_nc2(time_index2)=dim_length_nc2(time_index2) + write(unit_logfile,'(A,i3,2A,2f16.2)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & + ,minval(var3d_nc2(i,:,:,t)),maxval(var3d_nc2(i,:,:,t)) + + endif + else + write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc2(i)) + meteo_var_nc2_available(t,i)=.false. + endif + + if (i.eq.precip_index2) then + !Don't allow precip below the cutoff value + where (var3d_nc2(i,:,:,t).lt.precip_cutoff) var3d_nc2(i,:,:,t)=0. + endif + + enddo + + status_nc2 = NF90_CLOSE (id_nc2) + + !Put in some basic data checks to see if file is corrupt + if (abs(maxval(var3d_nc2(temperature_index2,:,:,:))).gt.500) then + !write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc2(temperature_index,:,:,:)) + !write(unit_logfile,'(A)') ' STOPPING' + write(unit_logfile,'(A,e12.2)') ' WARNING: out of bounds temperature. Will not use these data but will continue calculations: ', maxval(var3d_nc2(temperature_index2,:,:,:)) + meteo_var_nc2_available(temperature_index2,t)=.false. + !stop + endif + if (abs(maxval(var3d_nc2(precip_index2,:,:,:))).gt.1000) then + !write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc2(temperature_index,:,:,:)) + !write(unit_logfile,'(A)') ' STOPPING' + write(unit_logfile,'(A,e12.2)') ' WARNING: out of bounds precipitation. Will not use these data but will continue calculations: ', maxval(var3d_nc2(precip_index2,:,:,:)) + meteo_var_nc2_available(precip_index2,t)=.false. + !stop + endif + if (abs(maxval(var3d_nc2(relhumidity_index2,:,:,:))).gt.1.10) then + write(unit_logfile,'(A,e12.2)') ' WARNING: out of bounds humidity. Will not use these data but will continue calculations: ', maxval(var3d_nc2(relhumidity_index2,:,:,:)) + meteo_var_nc2_available(relhumidity_index2,t)=.false. + !stop + endif + + i_grid_mid=int(dim_length_nc2(x_index)/2) + j_grid_mid=int(dim_length_nc2(y_index)/2) + dgrid_nc2(x_index2)=var1d_nc2(x_index2,i_grid_mid)-var1d_nc2(x_index2,i_grid_mid-1) + dgrid_nc2(y_index2)=var1d_nc2(y_index2,j_grid_mid)-var1d_nc2(y_index2,j_grid_mid-1) + + !If the coordinates are in km instead of metres then change to metres (assuming the difference is not going to be > 100 km + if (dgrid_nc2(x_index).lt.100.and.meteo_nc2_projection_type.ne.LL_projection_index) then + dgrid_nc2=dgrid_nc2*1000. + var1d_nc2(x_index2,:)=var1d_nc2(x_index2,:)*1000. + var1d_nc2(y_index2,:)=var1d_nc2(y_index2,:)*1000. + endif + write(unit_logfile,'(A,2f12.1)') ' Grid spacing X and Y (m): ', dgrid_nc2(x_index2),dgrid_nc2(y_index2) + + !Set the array dimensions to the available ones. Can be changed later based on input information, particularly for time + end_dim_nc2=dim_length_nc2 + start_dim_nc2=dim_start_nc2 + + endif !End if exists + enddo !end t loop + + + !NOTE: the below loop is currently just relevant for the runway application (calculation_type = Avinor). If more than one hour of MET_Nordic_analysis is available, + !interpolate the values between the first and the last value (NB: Should therefore only be used when it is known that there is likely max. two consecutive hours available.) + !Set the meteo_nc2_available to .true. for these timesteps, so that the underlying meteorology will be overwritten by these values in "save_meteodata" subroutine. + if (count(meteo_nc2_available) == 2 .and. calculation_type=="Avinor") then !Check if MET_Nordic_analysis is available for more than one hour. + f = findloc(meteo_nc2_available, .true., back = .false.) + l = findloc(meteo_nc2_available, .true., back = .true.) + first_value = f(1) + last_value = l(1) + + do t = first_value, last_value + var3d_nc2(:,:,:,t) = var3d_nc2(:,:,:,first_value) + (t-first_value)*(var3d_nc2(:,:,:,last_value)-var3d_nc2(:,:,:,first_value))/(last_value-first_value) + meteo_nc2_available(t) = .true. + + enddo + endif + if (allocated(var3d_nc2_dp)) deallocate (var3d_nc2_dp) + if (allocated(var2d_nc2_dp)) deallocate (var2d_nc2_dp) + + end subroutine NORTRIP_read_analysismeteo_netcdf4 \ No newline at end of file diff --git a/NORTRIP_read_met_forecast_netcdf4.f90 b/NORTRIP_read_met_forecast_netcdf4.f90 new file mode 100644 index 0000000..23f2370 --- /dev/null +++ b/NORTRIP_read_met_forecast_netcdf4.f90 @@ -0,0 +1,335 @@ +subroutine NORTRIP_read_MET_Nordic_forecast_netcdf4 + !Reads met forecast data (Based on model data from MEPS (MetCoOp-Ensemble Prediction System) and observations from met.no, Netatmo, and Bergensvaeret) + + use NORTRIP_multiroad_index_definitions + + use netcdf + + implicit none + + + !Local variables + integer status_nc !Error message + integer id_nc + integer dim_id_nc(num_dims_nc_forecast) + integer xtype_nc(num_var_nc_forecast) + integer natts_nc(num_var_nc_forecast) + integer var_id_nc(num_var_nc_forecast) + + + character(256) dimname_temp + integer i + integer i_grid_mid,j_grid_mid + real dlat_nc + integer exists + integer ii,jj,tt + integer new_start_date_input(num_date_index) + logical found_file + character(256) pathname_nc_in,filename_nc_in,filename_alternative_nc_in + + integer dim_id_nc_ensemble + logical ensemble_dim_flag + integer nDims + + double precision, allocatable :: var1d_nc_forecast_dp(:) + double precision, allocatable :: var2d_nc_forecast_dp(:,:) + real, allocatable :: var3d_emep(:,:,:) + real, allocatable :: var3d_nc_forecast_old(:,:,:,:) + real, allocatable :: var3d_nc_short(:,:,:) + + double precision temp_date + double precision date_to_number + + integer var_id_nc_projection + + real,allocatable :: var1d_nc_forecast_old(:,:) + + integer :: a_temp(num_date_index) + + integer :: meteo_nc_timesteps_forecast + + integer :: j,h,t + character(10) :: time !for printing date and time + + write(unit_logfile,'(A)') '================================================================' + write(unit_logfile,'(A)') 'Reading forecast meteorological data (NORTRIP_read_MET_Nordic_forecast_netcdf4)' + write(unit_logfile,'(A)') '================================================================' + + + pathname_nc_in=pathname_nc_forecast + filename_nc_in=filename_nc_forecast_template + temp_date=date_to_number(start_date_input,ref_year) + call number_to_date(temp_date+(-1)/dble(24.),new_start_date_input,ref_year) !This opens the forecast file from the previous hour, as the precip and radiation is cumulative, and thus the first value is zero. !TODO: Make a fix for only precipitation and radiation, so that the other variables can be read from the most recent file. + + call date_to_datestr_bracket(new_start_date_input,filename_nc_in,filename_nc) + call date_to_datestr_bracket(new_start_date_input,pathname_nc_in,pathname_nc) + pathfilename_nc=trim(pathname_nc)//trim(filename_nc) + found_file = .True. !To capture the case when the file exist on the first try. + + meteo_nc_forecast_available = .true. + + if (.not.allocated(meteo_var_nc_forecast_available)) allocate (meteo_var_nc_forecast_available(n_hours_input,num_var_nc_forecast)) + meteo_var_nc_forecast_available=.true. + + !Test existence of the filename. + inquire(file=trim(pathfilename_nc),exist=exists) + + if (.not.exists) then + write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf file does not exist: ', trim(pathfilename_nc) + write(unit_logfile,'(A)') ' Will try every hour for the past 25 hours.' + + !Start search back 24 hours + new_start_date_input=start_date_input + found_file=.false. + do i=1,25 + temp_date=date_to_number(new_start_date_input,ref_year) + call number_to_date(temp_date-1./24.,new_start_date_input,ref_year) + call date_to_datestr_bracket(new_start_date_input,filename_nc_in,filename_nc) + call date_to_datestr_bracket(new_start_date_input,pathname_nc_in,pathname_nc) + pathfilename_nc=trim(pathname_nc)//trim(filename_nc) + write(unit_logfile,'(A,A)') ' Trying: ', trim(pathfilename_nc) + inquire(file=trim(pathfilename_nc),exist=exists) + if (exists) then + found_file=.true. + exit + else + found_file=.false. + endif + enddo + + if (.not.found_file) then + write(unit_logfile,'(A,A)') ' WARNING: Forecast meteo netcdf file still does not exist: ', trim(pathfilename_nc) + meteo_nc_forecast_available=.False. + + !stop 8 + else + write(unit_logfile,'(A,A)') ' Found earlier forecast meteo netcdf file: ', trim(pathfilename_nc) + endif + + endif + + if ( found_file ) then + + !Open the netcdf file for reading + write(unit_logfile,'(2A)') ' Opening netcdf forecast meteo file: ',trim(pathfilename_nc) + status_nc = NF90_OPEN (pathfilename_nc, NF90_NOWRITE, id_nc) + if (status_nc .NE. NF90_NOERR) then + write(unit_logfile,'(A,I)') 'ERROR opening forecast netcdf file: ',status_nc + !stop 38 + endif + + + !Find the projection. If no projection then in lat lon coordinates + status_nc = NF90_INQ_VARID (id_nc,trim(projection_name_nc_forecast),var_id_nc_projection) + + if (status_nc.eq.NF90_NOERR) then + !If there is a projection then read in the attributes. All these are doubles + !status_nc = nf90_inquire_variable(id_nc, var_id_nc_projection, natts = numAtts_projection) + status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'standard_parallel', meteo_nc_forecast_projection_attributes(1:2)) + status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'longitude_of_central_meridian', meteo_nc_forecast_projection_attributes(3)) + status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'latitude_of_projection_origin', meteo_nc_forecast_projection_attributes(4)) + status_nc = nf90_get_att(id_nc, var_id_nc_projection, 'earth_radius', meteo_nc_forecast_projection_attributes(5)) + meteo_nc_forecast_projection_type=LCC_projection_index + + write(unit_logfile,'(A,5f12.2)') 'Reading lambert_conformal_conic projection. ',meteo_nc_forecast_projection_attributes(1:5) + else + meteo_nc_forecast_projection_type=LL_projection_index + endif + + status_nc = NF90_INQ_DIMID (id_nc,dim_name_nc(x_index_forecast),dim_id_nc(x_index_forecast)) + status_nc = NF90_INQUIRE_DIMENSION (id_nc,dim_id_nc(x_index_forecast),dimname_temp,dim_length_nc_forecast(x_index_forecast)) + status_nc = NF90_INQ_DIMID (id_nc,dim_name_nc(y_index_forecast),dim_id_nc(y_index_forecast)) + status_nc = NF90_INQUIRE_DIMENSION (id_nc,dim_id_nc(y_index_forecast),dimname_temp,dim_length_nc_forecast(y_index_forecast)) + status_nc = NF90_INQ_DIMID (id_nc,dim_name_nc(time_index_forecast),dim_id_nc(time_index_forecast)) + status_nc = NF90_INQUIRE_DIMENSION (id_nc,dim_id_nc(time_index_forecast),dimname_temp,dim_length_nc_forecast(time_index_forecast)) + write(unit_logfile,'(A,3I)') ' Pos of dimensions (x,y,t): ',dim_id_nc + write(unit_logfile,'(A,3I)') ' Size of dimensions (x,y,t): ',dim_length_nc_forecast + + if (number_of_time_steps.ne.0) then + dim_length_nc_forecast(time_index_forecast)=number_of_time_steps + write(unit_logfile,'(A,3I)') ' WARNING: Reducing dimensions of (t) to save space: ',dim_length_nc_forecast(time_index_forecast) + endif + + !Allocate the nc arrays for reading + allocate (var1d_nc_forecast_old(num_dims_nc_forecast,maxval(dim_length_nc_forecast))) !x and y and time maximum dimmensions + allocate (var1d_nc_forecast_dp(maxval(dim_length_nc_forecast))) !x and y and time maximum dimmensions + allocate (var3d_nc_forecast_old(num_var_nc_forecast,dim_length_nc_forecast(x_index_forecast),dim_length_nc_forecast(y_index_forecast),dim_length_nc_forecast(time_index_forecast))) + allocate (var2d_nc_forecast(num_var_nc_forecast,dim_length_nc_forecast(x_index_forecast),dim_length_nc_forecast(y_index_forecast))) !Lat and lon + allocate (var2d_nc_forecast_dp(dim_length_nc_forecast(x_index_forecast),dim_length_nc_forecast(y_index_forecast))) !Lat and lon + + if (index(meteo_data_type,'emep').gt.0) then + allocate (var3d_emep(dim_length_nc_forecast(x_index_forecast),dim_length_nc_forecast(y_index_forecast),dim_length_nc_forecast(time_index_forecast))) + else + allocate (var3d_nc_short(dim_length_nc_forecast(x_index_forecast),dim_length_nc_forecast(y_index_forecast),dim_length_nc_forecast(time_index_forecast))) + endif + + + !Read the x, y and time values + do i=1,num_dims_nc_forecast + status_nc = NF90_INQ_VARID (id_nc, trim(dim_name_nc(i)), var_id_nc(i)) + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var1d_nc_forecast_old(i,1:dim_length_nc_forecast(i)), start=(/dim_start_nc_forecast(i)/), count=(/dim_length_nc_forecast(i)/)) + + if (i.eq.time_index_forecast) then + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var1d_nc_forecast_dp(1:dim_length_nc_forecast(i)), start=(/dim_start_nc_forecast(i)/), count=(/dim_length_nc_forecast(i)/)) + + var1d_nc_forecast_old(i,:)=real(var1d_nc_forecast_dp(:)) + write(unit_logfile,'(3A,2i14)') ' ',trim(dim_name_nc(i)),' (min, max in hours): ' & + ,int((var1d_nc_forecast_old(i,1)-var1d_nc_forecast_old(i,1))/3600.+.5)+1 & + ,int((var1d_nc_forecast_old(i,dim_length_nc_forecast(i))-var1d_nc_forecast_old(i,1))/3600.+.5)+1 + + else + write(unit_logfile,'(3A,2f12.2)') ' ',trim(dim_name_nc(i)),' (min, max in km): ' & + ,minval(var1d_nc_forecast_old(i,1:dim_length_nc_forecast(i))),maxval(var1d_nc_forecast_old(i,1:dim_length_nc_forecast(i))) + endif + + enddo + + !Read through the variables in a loop + do i=1,num_var_nc_forecast + + status_nc = NF90_INQ_VARID (id_nc, trim(var_name_nc_forecast(i)), var_id_nc(i)) + + if (status_nc.eq.NF90_NOERR) then + if (i.eq.lat_index_forecast.or.i.eq.lon_index_forecast) then + + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var2d_nc_forecast_dp,start=(/dim_start_nc_forecast/), count=(/dim_length_nc_forecast/)) + var2d_nc_forecast(i,:,:)=real(var2d_nc_forecast_dp) + + write(unit_logfile,'(A,i3,A,2A,2f16.4)') ' ',status_nc,' ',trim(var_name_nc_forecast(i)),' (min, max): ' & + ,minval(var2d_nc_forecast(i,:,:)),maxval(var2d_nc_forecast(i,:,:)) + else + + if (index(meteo_data_type,'emep').gt.0) then + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var3d_emep,start=(/dim_start_nc_forecast/), count=(/dim_length_nc_forecast/)) + var3d_nc_forecast_old(i,:,:,:)=var3d_emep(:,:,:) + else + status_nc = NF90_GET_VAR (id_nc, var_id_nc(i), var3d_nc_short,start=(/dim_start_nc_forecast/), count=(/dim_length_nc_forecast/)) + var3d_nc_forecast_old(i,:,:,:)=var3d_nc_short(:,:,:) + endif + + !Make appropriate changes, going backwards so as to overwrite the existing data + if (i.eq.precip_index_forecast) then + + !Don't allow precip below the cutoff value + where (var3d_nc_forecast_old(i,:,:,:).lt.precip_cutoff) var3d_nc_forecast_old(i,:,:,:)=0. + endif + + if (i.eq.shortwaveradiation_index_forecast) then + do tt=dim_length_nc_forecast(time_index_forecast),2,-1 + var3d_nc_forecast_old(i,:,:,tt)=(var3d_nc_forecast_old(i,:,:,tt)-var3d_nc_forecast_old(i,:,:,tt-1))/3600. + enddo + endif + + if (i.eq.longwaveradiation_index_forecast) then + do tt=dim_length_nc_forecast(time_index_forecast),2,-1 + var3d_nc_forecast_old(i,:,:,tt)=(var3d_nc_forecast_old(i,:,:,tt)-var3d_nc_forecast_old(i,:,:,tt-1))/3600. + enddo + endif + + write(unit_logfile,'(A,i3,A,2A,2f16.2)') ' ',status_nc,' ',trim(var_name_nc_forecast(i)),' (min, max): ' & + ,minval(var3d_nc_forecast_old(i,:,:,:)),maxval(var3d_nc_forecast_old(i,:,:,:)) + endif + var_available_nc(i)=.true. + else + write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc_forecast(i)) + var_available_nc(i)=.false. + endif + enddo + + status_nc = NF90_CLOSE (id_nc) + + !Put in some basic data checks to see if file is corrupt !TODO: Don't stop the whole thing, just abort reading the forecast data (or that particular variable from forecast?) + ! if (abs(maxval(var3d_nc_forecast_old(temperature_index_forecast,:,:,:))).gt.500) then + ! write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc_forecast_old(temperature_index_forecast,:,:,:)) + ! write(unit_logfile,'(A)') ' STOPPING' + ! stop + ! endif + + ! if (abs(maxval(var3d_nc_forecast_old(shortwaveradiation_index,:,:,:))).gt.5000) then + ! write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds short wave radiation: ', maxval(var3d_nc_forecast_old(shortwaveradiation_index,:,:,:)) + ! write(unit_logfile,'(A)') ' STOPPING' + ! stop + ! endif + + !Calculate angle difference between North and the Model Y direction based on the middle grids + !Not correct, needs to be fixed !TODO: Is this fixed? + i_grid_mid=int(dim_length_nc_forecast(x_index_forecast)/2) + j_grid_mid=int(dim_length_nc_forecast(y_index_forecast)/2) + + dgrid_nc_forecast(x_index_forecast)=var1d_nc_forecast_old(x_index_forecast,i_grid_mid)-var1d_nc_forecast_old(x_index_forecast,i_grid_mid-1) + dgrid_nc_forecast(y_index_forecast)=var1d_nc_forecast_old(y_index_forecast,j_grid_mid)-var1d_nc_forecast_old(y_index_forecast,j_grid_mid-1) + + !If the coordinates are in km instead of metres then change to metres (assuming the difference is not going to be > 100 km + if (dgrid_nc_forecast(x_index_forecast).lt.100) then + dgrid_nc_forecast=dgrid_nc_forecast*1000. + var1d_nc_forecast_old(x_index_forecast,:)=var1d_nc_forecast_old(x_index_forecast,:)*1000. + var1d_nc_forecast_old(y_index_forecast,:)=var1d_nc_forecast_old(y_index_forecast,:)*1000. + endif + + !angle_nc=180./3.14159*acos(dlat_nc*3.14159/180.*6.37e6/dgrid_nc_forecast(x_index_forecast)) + write(unit_logfile,'(A,2f12.1)') ' Grid spacing X and Y (m): ', dgrid_nc_forecast(x_index_forecast),dgrid_nc_forecast(y_index_forecast) + + meteo_nc_timesteps_forecast = nint(1 + (dim_length_nc_forecast(time_index_forecast)-1)/timestep) + + !Fill date_nc_forecast array that is used to match meteo dates to the date range specified in the simulation call. + allocate(date_nc_forecast(num_date_index,meteo_nc_timesteps_forecast)) + + call number_to_date(dble(int(var1d_nc_forecast_old(time_index_forecast,1)/sngl(seconds_in_hour*hours_in_day)+1./24./60.)),date_nc_forecast(:,1),ref_year) + + + date_nc_forecast(hour_index,1)=int((var1d_nc_forecast_old(time_index_forecast,1)-(dble(int(var1d_nc_forecast_old(time_index_forecast,1)/sngl(seconds_in_hour*hours_in_day)+1./24./60.)))*sngl(seconds_in_hour*hours_in_day))/3600.+.5) + + do t=1,meteo_nc_timesteps_forecast-1 + a_temp=date_nc_forecast(:,1) + call minute_increment(int(minutes_in_hour*timestep)*t,a_temp(1),a_temp(2),a_temp(3),a_temp(4),a_temp(5)) + date_nc_forecast(:,t+1)=a_temp + enddo + + !Check if timestep is != 1; if true, allocate new, larger arrays and interpolate the hourly values into the new arrays. + if ( timestep .ne. 1 ) then + call date_and_time(TIME=time) + write(*,*) "Interpolation loop start: ", time + + !Allocate an array with the new time_index_forecast. + if (allocated(var3d_nc_forecast)) deallocate(var3d_nc_forecast) + allocate (var3d_nc_forecast(num_var_nc_forecast,dim_length_nc_forecast(x_index_forecast),dim_length_nc_forecast(y_index_forecast),nint(1 + (dim_length_nc_forecast(time_index)-1)/timestep))) + + allocate(var1d_nc_forecast(num_dims_nc_forecast,maxval(dim_length_nc_forecast))) + + do i = int(1/timestep), nint(dim_length_nc_forecast(time_index_forecast)/timestep) + + var3d_nc_forecast(:,:,:,i-int(1/timestep)+1) = var3d_nc_forecast_old(:,:,:,floor(i*timestep)) + ( var3d_nc_forecast_old(:,:,:,min(floor(i*timestep)+1,size(var3d_nc_forecast_old,dim=4))) - var3d_nc_forecast_old(:,:,:,floor(i*timestep))) * (i*timestep-floor(i*timestep)) !/1 + + var3d_nc_forecast(precip_index_forecast,:,:,i-int(1/timestep)+1) = max(0.,var3d_nc_forecast_old(precip_index_forecast,:,:,min(floor(i*timestep)+1,size(var3d_nc_forecast_old,dim=4)))/6) + + end do + + call date_and_time(TIME = time) + write(*,*) "Interpolation loop end: ", time + + var1d_nc_forecast(x_index,:) = var1d_nc_forecast_old(x_index,:) + var1d_nc_forecast(y_index,:) = var1d_nc_forecast_old(y_index,:) + + else + var1d_nc_forecast = var1d_nc_forecast_old + var3d_nc_forecast = var3d_nc_forecast_old + end if + + !Set the array dimensions to the available ones. Can be changed later based on input information, particularly for time + end_dim_nc_forecast=dim_length_nc_forecast + end_dim_nc_forecast(time_index_forecast) = size(var3d_nc_forecast,dim=4) + start_dim_nc_forecast=dim_start_nc_forecast + + else + meteo_nc_forecast_available = .False. + write(*,*) "Do not replace default meteo data with forecast meteo data because no file was found." + end if + + if (allocated(var3d_nc_forecast_old)) deallocate(var3d_nc_forecast_old) + if (allocated(var1d_nc_forecast_old)) deallocate(var1d_nc_forecast_old) + if (allocated(var2d_nc_forecast_dp)) deallocate (var2d_nc_forecast_dp) + !if (allocated(var3d_nc_forecast_dp)) deallocate(var3d_nc_forecast_dp) + if (allocated(var3d_emep)) deallocate(var3d_emep) + + +end subroutine NORTRIP_read_MET_Nordic_forecast_netcdf4 \ No newline at end of file diff --git a/NORTRIP_read_t2m500yr_netcdf4.f90 b/NORTRIP_read_t2m500yr_netcdf4.f90 deleted file mode 100644 index 17506d8..0000000 --- a/NORTRIP_read_t2m500yr_netcdf4.f90 +++ /dev/null @@ -1,415 +0,0 @@ - - subroutine NORTRIP_read_analysismeteo_netcdf4 - !Reads yr temperature 66 hour forecast data - - use NORTRIP_multiroad_index_definitions - !Update to netcdf 4 and 64 bit in this version 2 of NORTRIP_read_t2m500yr_netcdf - use netcdf - - implicit none - - !include 'netcdf.inc' - - !Local variables - integer status_nc2 !Error message - integer id_nc2 - integer dim_id_nc2(num_dims_nc2) - integer xtype_nc2(num_var_nc2) - integer natts_nc2(num_var_nc2) - integer var_id_nc2(num_var_nc2) - integer dim_length_metcoop_nc2(num_dims_nc2+1) - integer dim_start_metcoop_nc2(num_dims_nc2+1) - - character(256) dimname_temp - integer i - integer i_grid_mid,j_grid_mid - real dlat_nc2 - integer exists - integer ii,jj,tt,t - - integer var_id_nc2_projection - character(256) pathname_nc2_in,filename_nc2_in - integer new_start_date_input(num_date_index) - double precision temp_date - double precision date_to_number - - double precision, allocatable :: var2d_nc2_dp(:,:) - double precision, allocatable :: var3d_nc2_dp(:,:) - - logical dim_read_flag - - write(unit_logfile,'(A)') '================================================================' - write(unit_logfile,'(A)') 'Reading additional meteorological data (NORTRIP_read_analysismeteo_netcdf4)' - write(unit_logfile,'(A)') '================================================================' - - pathfilename_nc2=trim(pathname_nc2)//trim(filename_nc2) - pathname_nc2_in=pathname_nc2 - filename_nc2_in=filename_nc2_template - new_start_date_input=start_date_input - - if (.not.allocated(meteo_nc2_available)) allocate (meteo_nc2_available(n_hours_input)) - if (.not.allocated(meteo_var_nc2_available)) allocate (meteo_var_nc2_available(n_hours_input,num_var_nc2)) - meteo_var_nc2_available=.true. - - dim_read_flag=.false. - - !Loop through the number of time steps nad read in data when available - do t=1,n_hours_input - temp_date=date_to_number(start_date_input,ref_year) - call number_to_date(temp_date+(t-1)/dble(24.),new_start_date_input,ref_year) - write(unit_logfile,'(a,7i)') 'Date array: ',t,new_start_date_input(1:6) - call date_to_datestr_bracket(new_start_date_input,filename_nc2_in,filename_nc2) - call date_to_datestr_bracket(new_start_date_input,pathname_nc2_in,pathname_nc2) - pathfilename_nc2=trim(pathname_nc2)//trim(filename_nc2) - - !Test existence of the filename. If does not exist then skip the time index - inquire(file=trim(pathfilename_nc2),exist=exists) - if (.not.exists) then - write(unit_logfile,'(A,A)') ' WARNING: Meteo netcdf2 file does not exist: ', trim(pathfilename_nc2) - meteo_nc2_available(t)=.false. - else - meteo_nc2_available(t)=.true. - endif - - !Open the netcdf file for reading - if (meteo_nc2_available(t)) then - - write(unit_logfile,'(2A)') ' Opening netcdf meteo file: ',trim(pathfilename_nc2) - status_nc2 = NF90_OPEN (pathfilename_nc2, NF90_NOWRITE, id_nc2) - if (status_nc2 .NE. NF90_NOERR) write(unit_logfile,'(A,I)') 'ERROR opening netcdf file: ',status_nc2 - - !Find the projection. If no projection then in lat lon coordinates - status_nc2 = NF90_INQ_VARID (id_nc2,trim(projection_name_nc2),var_id_nc2_projection) - - if (status_nc2.eq.NF90_NOERR) then - !If there is a projection then read in the attributes. All these are doubles - !status_nc = nf90_inquire_variable(id_nc, var_id_nc_projection, natts = numAtts_projection) - status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'standard_parallel', meteo_nc2_projection_attributes(1:2)) - status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'longitude_of_central_meridian', meteo_nc2_projection_attributes(3)) - status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'latitude_of_projection_origin', meteo_nc2_projection_attributes(4)) - status_nc2 = nf90_get_att(id_nc2, var_id_nc2_projection, 'earth_radius', meteo_nc2_projection_attributes(5)) - meteo_nc2_projection_type=LCC_projection_index - - write(unit_logfile,'(A,5f12.2)') 'Reading lambert_conformal_conic projection. ',meteo_nc2_projection_attributes(1:5) - else - meteo_nc2_projection_type=LL_projection_index - endif - - if (.not.dim_read_flag) then - !Find out the x,y and time dimmensions of the file - status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(x_index2),dim_id_nc2(x_index2)) - status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(x_index2),dimname_temp,dim_length_nc2(x_index2)) - status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(y_index2),dim_id_nc2(y_index2)) - status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(y_index2),dimname_temp,dim_length_nc2(y_index2)) - - call NORTRIP_reduce_meteo_region2(id_nc2) - dim_read_flag=.true. - - endif - - status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(time_index2),dim_id_nc2(time_index2)) - status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(time_index2),dimname_temp,dim_length_nc2(time_index2)) - write(unit_logfile,'(A,3I)') ' Size of dimensions (x,y,t): ',dim_length_nc2 - - dim_length_nc2(time_index)=number_of_time_steps - write(unit_logfile,'(A,3I)') ' WARNING: Reducing dimensions of (t) to save space: ',dim_length_nc2(time_index) - - - !Allocate the nc arrays for reading - !write(*,*) dim_length_nc2(x_index2),dim_length_nc2(y_index2),dim_length_nc2(time_index2) - if (.not.allocated(var1d_nc2)) allocate (var1d_nc2(num_dims_nc2,maxval(dim_length_nc2))) !x and y and time maximum dimmensions - if (.not.allocated(var3d_nc2)) allocate (var3d_nc2(num_var_nc2,dim_length_nc2(x_index2),dim_length_nc2(y_index2),n_hours_input)) - if (.not.allocated(var2d_nc2)) allocate (var2d_nc2(num_var_nc2,dim_length_nc2(x_index2),dim_length_nc2(y_index2))) !Lat and lon and elevation - if (.not.allocated(var3d_nc2_dp)) allocate (var3d_nc2_dp(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) - if (.not.allocated(var2d_nc2_dp)) allocate (var2d_nc2_dp(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) !Lat and lon - - !Set the number of hours to be read - - !Read the x, y and time values - do i=1,num_dims_nc2 - status_nc2 = NF90_INQ_VARID (id_nc2, trim(dim_name_nc2(i)), var_id_nc2(i)) - !status_nc2 = NF_GET_VARA_REAL (id_nc2, var_id_nc2(i), dim_start_nc2(i), dim_length_nc2(i), var1d_nc2(i,:)) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var1d_nc2(i,1:dim_length_nc2(i)), start=(/dim_start_nc2(i)/), count=(/dim_length_nc2(i)/)) - if (i.eq.time_index2) then - write(unit_logfile,'(3A,2i12)') ' ',trim(dim_name_nc2(i)),' (min, max in hours): ' & - ,minval(int((var1d_nc2(i,1:dim_length_nc2(i))-var1d_nc2(i,dim_start_nc2(i)))/3600.+.5)+1) & - ,maxval(int((var1d_nc2(i,1:dim_length_nc2(i))-var1d_nc2(i,dim_start_nc2(i)))/3600.+.5)+1) - else - write(unit_logfile,'(3A,2f12.2)') ' ',trim(dim_name_nc2(i)),' (min, max in km): ' & - ,minval(var1d_nc2(i,1:dim_length_nc2(i))),maxval(var1d_nc2(i,1:dim_length_nc2(i))) - endif - - enddo - - - !MetCoOp data has 3 dimensions. z is 1 so must adjust this. - !dim_length_metcoop_nc(1:2)=dim_length_nc(1:2) - !dim_length_metcoop_nc(3)=1 - !dim_length_metcoop_nc(4)=dim_length_nc(time_index) - !dim_start_metcoop_nc(1:2)=dim_start_nc(1:2) - !dim_start_metcoop_nc(3)=1 - !dim_start_metcoop_nc(4)=dim_start_nc(time_index) - - !Read through the variables in a loop - do i=1,num_var_nc2 - !write(*,*) i,trim(var_name_nc(i)) - status_nc2 = NF90_INQ_VARID (id_nc2, trim(var_name_nc2(i)), var_id_nc2(i)) - !write(*,*) 'Status1: ',status_nc2,id_nc2,var_id_nc2(i),trim(var_name_nc2(i)),NF_NOERR - !write(*,*) 'Status1: ',dim_start_metcoop_nc - !write(*,*) 'Status1: ',dim_length_metcoop_nc - if (status_nc2.eq.NF90_NOERR) then - if (i.eq.lat_index2.or.i.eq.lon_index2) then - !write(*,*) id_nc2, var_id_nc2(i), dim_start_nc2(1:2), dim_length_nc2(1:2) - !status_nc = NF_GET_VARA_REAL (id_nc, var_id_nc(i), dim_start_metcoop_nc(1:2), dim_length_metcoop_nc(1:2), var2d_nc(i,:,:)) - !status_nc2 = NF_GET_VARA_DOUBLE (id_nc2, var_id_nc2(i), dim_start_nc2(1:2), dim_length_nc2(1:2), var2d_nc2_dp);var2d_nc2(i,:,:)=real(var2d_nc2_dp) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var2d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/));var2d_nc2(i,:,:)=real(var2d_nc2_dp) - write(unit_logfile,'(A,i3,2A,2f16.4)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & - ,minval(var2d_nc2(i,:,:)),maxval(var2d_nc2(i,:,:)) - - elseif (i.eq.elevation_index2) then - - !status_nc2 = NF_GET_VARA_DOUBLE (id_nc2, var_id_nc2(i), dim_start_nc2(1:2), dim_length_nc2(1:2), var2d_nc2_dp);var2d_nc2(i,:,:)=real(var2d_nc2_dp) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var2d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/));var2d_nc2(i,:,:)=real(var2d_nc2_dp) - write(unit_logfile,'(A,i3,2A,2f16.4)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & - ,minval(var2d_nc2(i,:,:)),maxval(var2d_nc2(i,:,:)) - !write(*,*) maxval(var2d_nc2(i,:,:)) - - else - !write(*,*) id_nc2, var_id_nc2(i) - !write(*,*) dim_start_nc2 - !write(*,*) dim_length_nc2 - !Due to memory problems must loop through time on this variable - !do t=1,dim_length_nc2(time_index2) - dim_start_nc2(time_index2)=1 - dim_length_nc2(time_index2)=1 - !status_nc2 = NF_GET_VARA_DOUBLE (id_nc2, var_id_nc2(i), dim_start_nc2, dim_length_nc2, var3d_nc2_dp);var3d_nc2(i,:,:,t)=real(var3d_nc2_dp) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var3d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/));var3d_nc2(i,:,:,t)=real(var3d_nc2_dp) - !enddo - dim_start_nc2(time_index2)=1 - dim_length_nc2(time_index2)=dim_length_nc2(time_index2) - write(unit_logfile,'(A,i3,2A,2f16.2)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & - ,minval(var3d_nc2(i,:,:,t)),maxval(var3d_nc2(i,:,:,t)) - - endif - else - write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc2(i)) - meteo_var_nc2_available(t,i)=.false. - endif - - if (i.eq.precip_index2) then - !Don't allow precip below the cutoff value - where (var3d_nc2(i,:,:,t).lt.precip_cutoff) var3d_nc2(i,:,:,t)=0. - endif - - enddo - - status_nc2 = NF90_CLOSE (id_nc2) - - !Put in some basic data checks to see if file is corrupt - if (abs(maxval(var3d_nc2(temperature_index2,:,:,:))).gt.500) then - !write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc2(temperature_index,:,:,:)) - !write(unit_logfile,'(A)') ' STOPPING' - write(unit_logfile,'(A,e12.2)') ' WARNING: out of bounds temperature. Will not use these data but will continue calculations: ', maxval(var3d_nc2(temperature_index2,:,:,:)) - meteo_var_nc2_available(temperature_index2,t)=.false. - !stop - endif - if (abs(maxval(var3d_nc2(precip_index2,:,:,:))).gt.1000) then - !write(unit_logfile,'(A,e12.2)') ' ERROR: out of bounds temperature: ', maxval(var3d_nc2(temperature_index,:,:,:)) - !write(unit_logfile,'(A)') ' STOPPING' - write(unit_logfile,'(A,e12.2)') ' WARNING: out of bounds precipitation. Will not use these data but will continue calculations: ', maxval(var3d_nc2(precip_index2,:,:,:)) - meteo_var_nc2_available(precip_index2,t)=.false. - !stop - endif - if (abs(maxval(var3d_nc2(relhumidity_index2,:,:,:))).gt.1.10) then - write(unit_logfile,'(A,e12.2)') ' WARNING: out of bounds humidity. Will not use these data but will continue calculations: ', maxval(var3d_nc2(relhumidity_index2,:,:,:)) - meteo_var_nc2_available(relhumidity_index2,t)=.false. - !stop - endif - - i_grid_mid=int(dim_length_nc2(x_index)/2) - j_grid_mid=int(dim_length_nc2(y_index)/2) - dgrid_nc2(x_index2)=var1d_nc2(x_index2,i_grid_mid)-var1d_nc2(x_index2,i_grid_mid-1) - dgrid_nc2(y_index2)=var1d_nc2(y_index2,j_grid_mid)-var1d_nc2(y_index2,j_grid_mid-1) - - !If the coordinates are in km instead of metres then change to metres (assuming the difference is not going to be > 100 km - if (dgrid_nc2(x_index).lt.100.and.meteo_nc2_projection_type.ne.LL_projection_index) then - dgrid_nc2=dgrid_nc2*1000. - var1d_nc2(x_index2,:)=var1d_nc2(x_index2,:)*1000. - var1d_nc2(y_index2,:)=var1d_nc2(y_index2,:)*1000. - endif - write(unit_logfile,'(A,2f12.1)') ' Grid spacing X and Y (m): ', dgrid_nc2(x_index2),dgrid_nc2(y_index2) - - !Set the array dimensions to the available ones. Can be changed later based on input information, particularly for time - end_dim_nc2=dim_length_nc2 - start_dim_nc2=dim_start_nc2 - - endif !End if exists - enddo !end t loop - - if (allocated(var3d_nc2_dp)) deallocate (var3d_nc2_dp) - if (allocated(var2d_nc2_dp)) deallocate (var2d_nc2_dp) - - end subroutine NORTRIP_read_analysismeteo_netcdf4 - - subroutine NORTRIP_read_t2m500yr_netcdf4 - !Reads yr temperature 66 hour forecast data - !This is an older version and is no longer produced - - use NORTRIP_multiroad_index_definitions - !Update to netcdf 4 and 64 bit in this version 2 of NORTRIP_read_t2m500yr_netcdf - use netcdf - - implicit none - - !include 'netcdf.inc' - - !Local variables - integer status_nc2 !Error message - integer id_nc2 - integer dim_id_nc2(num_dims_nc2) - integer xtype_nc2(num_var_nc2) - integer natts_nc2(num_var_nc2) - integer var_id_nc2(num_var_nc2) - integer dim_length_metcoop_nc2(num_dims_nc2+1) - integer dim_start_metcoop_nc2(num_dims_nc2+1) - - character(256) dimname_temp - integer i - integer i_grid_mid,j_grid_mid - real dlat_nc2 - integer exists - integer ii,jj,tt,t - - double precision, allocatable :: var2d_nc2_dp(:,:) - double precision, allocatable :: var3d_nc2_dp(:,:) - - - write(unit_logfile,'(A)') '================================================================' - write(unit_logfile,'(A)') 'Reading meteorological data (NORTRIP_read_t2m500yr_netcdf v2)' - write(unit_logfile,'(A)') '================================================================' - - !pathname_nc='C:\BEDRE BYLUFT\NORTRIP implementation\test\'; - !filename_nc='AROME_1KM_OSLO_20141028_EPI.nc' - pathfilename_nc2=trim(pathname_nc2)//trim(filename_nc2) - - !Test existence of the filename. If does not exist then use default - inquire(file=trim(pathfilename_nc2),exist=exists) - if (.not.exists) then - write(unit_logfile,'(A,A)') ' ERROR: Meteo netcdf file does not exist: ', trim(pathfilename_nc2) - write(unit_logfile,'(A)') ' STOPPING' - !write(*,'(A,A)') ' ERROR: Meteo netcdf file does not exist. Stopping: ', trim(pathfilename_nc) - stop 30 - endif - - !Open the netcdf file for reading - write(unit_logfile,'(2A)') ' Opening netcdf meteo file: ',trim(pathfilename_nc2) - status_nc2 = NF90_OPEN (pathfilename_nc2, NF90_NOWRITE, id_nc2) - if (status_nc2 .NE. NF90_NOERR) write(unit_logfile,'(A,I)') 'ERROR opening netcdf file: ',status_nc2 - - !Find out the x,y and time dimmensions of the file - status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(x_index2),dim_id_nc2(x_index2)) - status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(x_index2),dimname_temp,dim_length_nc2(x_index2)) - status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(y_index2),dim_id_nc2(y_index2)) - status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(y_index2),dimname_temp,dim_length_nc2(y_index2)) - status_nc2 = NF90_INQ_DIMID (id_nc2,dim_name_nc2(time_index2),dim_id_nc2(time_index2)) - status_nc2 = NF90_INQUIRE_DIMENSION (id_nc2,dim_id_nc2(time_index2),dimname_temp,dim_length_nc2(time_index2)) - write(unit_logfile,'(A,3I)') ' Size of dimensions (x,y,t): ',dim_length_nc2 - - if (number_of_time_steps.ne.0) then - dim_length_nc2(time_index)=number_of_time_steps - write(unit_logfile,'(A,3I)') ' WARNING: Reducing dimensions of (t) to save space: ',dim_length_nc2(time_index) - endif - - !Allocate the nc arrays for reading - !write(*,*) dim_length_nc2(x_index2),dim_length_nc2(y_index2),dim_length_nc2(time_index2) - allocate (var1d_nc2(num_dims_nc2,maxval(dim_length_nc2))) !x and y and time maximum dimmensions - allocate (var3d_nc2(temperature_index2,dim_length_nc2(x_index2),dim_length_nc2(y_index2),dim_length_nc2(time_index2))) - allocate (var2d_nc2(elevation_index2,dim_length_nc2(x_index2),dim_length_nc2(y_index2))) !Lat and lon and elevation - allocate (var3d_nc2_dp(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) - allocate (var2d_nc2_dp(dim_length_nc2(x_index2),dim_length_nc2(y_index2))) !Lat and lon - - !Set the number of hours to be read - - !Read the x, y and time values - do i=1,num_dims_nc2 - status_nc2 = NF90_INQ_VARID (id_nc2, trim(dim_name_nc2(i)), var_id_nc2(i)) - !status_nc2 = NF_GET_VARA_REAL (id_nc2, var_id_nc2(i), dim_start_nc2(i), dim_length_nc2(i), var1d_nc2(i,:)) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var1d_nc2(i,1:dim_length_nc2(i)), start=(/dim_start_nc2(i)/), count=(/dim_length_nc2(i)/)) - if (i.eq.time_index2) then - write(unit_logfile,'(3A,2i12)') ' ',trim(dim_name_nc2(i)),' (min, max in hours): ' & - ,minval(int((var1d_nc2(i,1:dim_length_nc2(i))-var1d_nc2(i,dim_start_nc2(i)))/3600.+.5)+1) & - ,maxval(int((var1d_nc2(i,1:dim_length_nc2(i))-var1d_nc2(i,dim_start_nc2(i)))/3600.+.5)+1) - else - write(unit_logfile,'(3A,2f12.2)') ' ',trim(dim_name_nc2(i)),' (min, max in km): ' & - ,minval(var1d_nc2(i,1:dim_length_nc2(i))),maxval(var1d_nc2(i,1:dim_length_nc2(i))) - endif - - enddo - - !MetCoOp data has 3 dimensions. z is 1 so must adjust this. - !dim_length_metcoop_nc(1:2)=dim_length_nc(1:2) - !dim_length_metcoop_nc(3)=1 - !dim_length_metcoop_nc(4)=dim_length_nc(time_index) - !dim_start_metcoop_nc(1:2)=dim_start_nc(1:2) - !dim_start_metcoop_nc(3)=1 - !dim_start_metcoop_nc(4)=dim_start_nc(time_index) - - !Read through the variables in a loop - do i=1,num_var_nc2 - !write(*,*) i,trim(var_name_nc(i)) - status_nc2 = NF90_INQ_VARID (id_nc2, trim(var_name_nc2(i)), var_id_nc2(i)) - !write(*,*) 'Status1: ',status_nc2,id_nc2,var_id_nc2(i),trim(var_name_nc2(i)),NF_NOERR - !write(*,*) 'Status1: ',dim_start_metcoop_nc - !write(*,*) 'Status1: ',dim_length_metcoop_nc - if (status_nc2.eq.NF90_NOERR) then - if (i.eq.lat_index2.or.i.eq.lon_index2) then - !write(*,*) id_nc2, var_id_nc2(i), dim_start_nc2(1:2), dim_length_nc2(1:2) - !status_nc = NF_GET_VARA_REAL (id_nc, var_id_nc(i), dim_start_metcoop_nc(1:2), dim_length_metcoop_nc(1:2), var2d_nc(i,:,:)) - !status_nc2 = NF_GET_VARA_DOUBLE (id_nc2, var_id_nc2(i), dim_start_nc2(1:2), dim_length_nc2(1:2), var2d_nc2_dp);var2d_nc2(i,:,:)=real(var2d_nc2_dp) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var2d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/));var2d_nc2(i,:,:)=real(var2d_nc2_dp) - write(unit_logfile,'(A,i3,2A,2f16.4)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & - ,minval(var2d_nc2(i,:,:)),maxval(var2d_nc2(i,:,:)) - - elseif (i.eq.elevation_index2) then - - !status_nc2 = NF_GET_VARA_DOUBLE (id_nc2, var_id_nc2(i), dim_start_nc2(1:2), dim_length_nc2(1:2), var2d_nc2_dp);var2d_nc2(i,:,:)=real(var2d_nc2_dp) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var2d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/));var2d_nc2(i,:,:)=real(var2d_nc2_dp) - write(unit_logfile,'(A,i3,2A,2f16.4)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & - ,minval(var2d_nc2(i,:,:)),maxval(var2d_nc2(i,:,:)) - !write(*,*) maxval(var2d_nc2(i,:,:)) - - else - !write(*,*) id_nc2, var_id_nc2(i) - !write(*,*) dim_start_nc2 - !write(*,*) dim_length_nc2 - !Due to memory problems must loop through time on this variable - do t=1,dim_length_nc2(time_index2) - dim_start_nc2(time_index2)=t - dim_length_nc2(time_index2)=1 - !status_nc2 = NF_GET_VARA_DOUBLE (id_nc2, var_id_nc2(i), dim_start_nc2, dim_length_nc2, var3d_nc2_dp);var3d_nc2(i,:,:,t)=real(var3d_nc2_dp) - status_nc2 = NF90_GET_VAR (id_nc2, var_id_nc2(i), var3d_nc2_dp(:,:), start=(/dim_start_nc2/), count=(/dim_length_nc2/));var3d_nc2(i,:,:,t)=real(var3d_nc2_dp) - enddo - dim_start_nc2(time_index2)=1 - dim_length_nc2(time_index2)=dim_length_nc2(time_index2) - write(unit_logfile,'(A,i3,2A,2f16.2)') ' ',status_nc2,trim(var_name_nc2(i)),' (min, max): ' & - ,minval(var3d_nc2(i,:,:,:)),maxval(var3d_nc2(i,:,:,:)) - endif - else - write(unit_logfile,'(8A,8A)') ' Cannot read ',trim(var_name_nc2(i)) - endif - - - enddo - - status_nc2 = NF90_CLOSE (id_nc2) - - - !Set the array dimensions to the available ones. Can be changed later based on input information, particularly for time - end_dim_nc2=dim_length_nc2 - start_dim_nc2=dim_start_nc2 - - if (allocated(var3d_nc2_dp)) deallocate (var3d_nc2_dp) - if (allocated(var2d_nc2_dp)) deallocate (var2d_nc2_dp) - - end subroutine NORTRIP_read_t2m500yr_netcdf4 - \ No newline at end of file diff --git a/uEMEP/lambert_projection.f90 b/uEMEP/lambert_projection.f90 index 0540615..c39005d 100644 --- a/uEMEP/lambert_projection.f90 +++ b/uEMEP/lambert_projection.f90 @@ -49,7 +49,7 @@ subroutine lb2lambert_uEMEP(x,y,gl,gb,lon0,lat0) implicit none real, intent(in) ::gl,gb,lon0,lat0 real, intent(out)::x,y - real ::r,t + real ::r real ::PI real :: earth_radius,k,F,y0 real rad2deg @@ -73,7 +73,7 @@ subroutine lb2lambert2_uEMEP(x,y,gl,gb,projection_attributes) double precision, intent(in) :: projection_attributes(10) real, intent(in) ::gl,gb real, intent(out)::x,y - real ::r,t + real ::r real ::PI real :: earth_radius,k,F,y0 real deg2rad,rad2deg,k_lambert,lat0_lambert