1! { dg-options "-O3 -fgraphite-identity" } 2 3 MODULE MAIN1 4 INTEGER , PARAMETER :: IFMAX = 40 , IKN = 85 , ISTRG = 132 , & 5 & IERRN = 170 , ILEN_FLD = 80 6 CHARACTER PATH*2 , PPATH*2 , KEYWRD*8 , PKEYWD*8 , KEYWD*8 , & 7 & KTYPE*5 , RUNST*1 8 DIMENSION FIELD(IFMAX) , KEYWD(IKN) , RUNST(ISTRG) 9 LOGICAL :: DFAULT , CONC , DEPOS , DDEP , WDEP , RURAL , URBAN , & 10 & GRDRIS , NOSTD , NOBID , CLMPRO , MSGPRO , PERIOD , & 11 & OLM=.FALSE. 12 INTEGER :: NSRC , NREC , NGRP , NQF, & 13 & NARC , NOLM 14 CHARACTER NETID*8 , NETIDT*8 , PNETID*8 , NTID*8 , NTTYP*8 , & 15 & RECTYP*2 , PXSOID*8 , PESOID*8 , ARCID*8 16 ALLOCATABLE ::NETID(:) , RECTYP(:) , NTID(:) , NTTYP(:) , ARCID(:) 17 DATA (KEYWD(I),I=1,IKN)/'STARTING' , 'FINISHED' , 'TITLEONE' , & 18 & 'TITLETWO' , 'MODELOPT' , 'AVERTIME' , 'POLLUTID' , & 19 & 'HALFLIFE' , 'DCAYCOEF' , 'DEBUGOPT' , 'ELEVUNIT' , & 20 & 'FLAGPOLE' , 'RUNORNOT' , 'EVENTFIL' , 'SAVEFILE' , & 21 & 'INITFILE' , 'MULTYEAR' , 'ERRORFIL' , 'GASDEPDF' , & 22 & 'GDSEASON' , 'GASDEPVD' , 'GDLANUSE' , 'EVENTFIL' , & 23 & 'URBANOPT' , 'METHOD_2' , 'LOCATION' , 'SRCPARAM' , & 24 & 'BUILDHGT' , 'BUILDWID' , 'BUILDLEN' , 'XBADJ ' , & 25 & 'YBADJ ' , 'EMISFACT' , 'EMISUNIT' , 'PARTDIAM' , & 26 & 'MASSFRAX' , 'PARTDENS' , ' ' , ' ' , & 27 & ' ' , 'CONCUNIT' , 'DEPOUNIT' , 'HOUREMIS' , & 28 & 'GASDEPOS' , 'URBANSRC' , 'EVENTPER' , 'EVENTLOC' , & 29 & 'SRCGROUP' , 'GRIDCART' , 'GRIDPOLR' , 'DISCCART' , & 30 & 'DISCPOLR' , 'SURFFILE' , 'PROFFILE' , 'PROFBASE' , & 31 & ' ' , 'SURFDATA' , 'UAIRDATA' , 'SITEDATA' , & 32 & 'STARTEND' , 'DAYRANGE' , 'WDROTATE' , 'DTHETADZ' , & 33 & 'WINDCATS' , 'RECTABLE' , 'MAXTABLE' , 'DAYTABLE' , & 34 & 'MAXIFILE' , 'POSTFILE' , 'PLOTFILE' , 'TOXXFILE' , & 35 & 'EVENTOUT' , 'INCLUDED' , 'SCIMBYHR' , 'SEASONHR' , & 36 & 'AREAVERT' , 'PARTSIZE' , 'RANKFILE' , 'EVALCART' , & 37 & 'EVALFILE' , 'NO2EQUIL' , 'OZONEVAL' , 'OZONEFIL' , & 38 & 'NO2RATIO' , 'OLMGROUP'/ 39 DIMENSION RESTAB(9,6,5) , STAB(9) 40 DATA (((RESTAB(I,J,K),I=1,9),J=1,6),K=1,5)/1.E07 , 60. , 120. , & 41 & 100. , 200. , 150. , 1.E07 , 1.E07 , 80. , 1.E07 , 2000. , & 42 & 2000. , 2000. , 2000. , 2000. , 1.E07 , 1.E07 , 2500. , & 43 & 1.E07 , 1000. , 1000. , 1000. , 2000. , 2000. , 1.E07 , & 44 & 1.E07 , 1000. , 100. , 200. , 100. , 2000. , 100. , 1500. , & 45 & 0. , 0. , 300. , 400. , 150. , 350. , 300. , 500. , 450. , & 46 & 0. , 1000. , 0. , 300. , 150. , 200. , 200. , 300. , 300. , & 47 & 2000. , 400. , 1000. , 1.E07 , 1.E07 , 1.E07 , 350. , & 48 & 1.E07 , 700. , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 6500. , & 49 & 6500. , 3000. , 2000. , 2000. , 1.E07 , 1.E07 , 6500. , & 50 & 1.E07 , 400. , 300. , 500. , 600. , 1000. , 1.E07 , 1.E07 , & 51 & 300. , 100. , 150. , 100. , 1700. , 100. , 1200. , 0. , 0. ,& 52 & 200. , 400. , 200. , 350. , 300. , 500. , 450. , 0. , & 53 & 1000. , 0. , 300. , 150. , 200. , 200. , 300. , 300. , & 54 & 2000. , 400. , 800. , 1.E07 , 1.E07 , 1.E07 , 500. , 1.E07 ,& 55 & 1000. , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 9000. , & 56 & 6000. , 2000. , 2000. , 1.E07 , 1.E07 , 9000. , 1.E07 , & 57 & 1.E07 , 400. , 600. , 800. , 1600. , 1.E07 , 1.E07 , 800. , & 58 & 100. , 0. , 100. , 1500. , 100. , 1000. , 0. , 0. , 100. , & 59 & 400. , 150. , 350. , 300. , 500. , 450. , 0. , 0. , 1000. , & 60 & 300. , 150. , 200. , 200. , 300. , 300. , 2000. , 400. , & 61 & 1000. , 1.E07 , 1.E07 , 1.E07 , 800. , 1.E07 , 1600. , & 62 & 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 400. , & 63 & 1.E07 , 800. , 1.E07 , 1.E07 , 9000. , 1.E07 , 2000. , & 64 & 1000. , 600. , 2000. , 1200. , 1.E07 , 1.E07 , 800. , 100. ,& 65 & 0. , 10. , 1500. , 100. , 1000. , 0. , 0. , 50. , 100. , & 66 & 100. , 100. , 100. , 200. , 200. , 0. , 1000. , 100. , & 67 & 600. , 3500. , 3500. , 3500. , 500. , 500. , 2000. , 400. , & 68 & 3500. , 1.E07 , 100. , 120. , 100. , 200. , 150. , 1.E07 , & 69 & 1.E07 , 80. , 1.E07 , 2000. , 2000. , 1500. , 2000. , & 70 & 2000. , 1.E07 , 1.E07 , 2000. , 1.E07 , 1000. , 250. , & 71 & 350. , 500. , 700. , 1.E07 , 1.E07 , 300. , 100. , 50. , & 72 & 80. , 1500. , 100. , 1000. , 0. , 0. , 200. , 500. , 150. , & 73 & 350. , 300. , 500. , 450. , 0. , 1000. , 0. , 300. , 150. , & 74 & 200. , 200. , 300. , 300. , 2000. , 400. , 1000./ 75 END 76 SUBROUTINE SHAVE 77 USE MAIN1 78 IF ( PERIOD ) THEN 79 9020 FORMAT ('(''*'',8X,''X'',13X,''Y'',4X,',I1, & 80 &'(2X,3A4),4X,''ZELEV'', 4X,''ZHILL'',4X,''ZFLAG'',4X,''AVE'',5X,& 81 &_______ ________ ________'')') 82 ENDIF 83 DO IGRP = 1 , NUMGRP 84 IF ( IANPST(IGRP).EQ.1 ) THEN 85 IF ( IANFRM(IGRP).EQ.0 ) THEN 86 DO IREC = 1 , NUMREC 87 ENDDO 88 ENDIF 89 DO IREC = 1 , NUMREC 90 IF ( RECTYP(IREC).EQ.'DC' ) THEN 91 WRITE (IOUNIT,9082) SRCID(ISRF) , SRCTYP(ISRF) , & 92 & AXS(ISRF) , AYS(ISRF) , AZS(ISRF) & 93 & , (J,AXR(IREC+J-1),AYR(IREC+J-1), & 94 & HCLMSG(IREC+J-1,IHNUM,IGRP,IAVE, & 95 & ITYP),J=1,36) 96 9082 FORMAT (' BOUNDARY RECEPTOR NETWORK OF SOURCE ID: ', & 97 & 18(2(1X,I4,3X,F10.2,', ',F10.2,',',F13.5,A1, & 98 & '(',I8.8,')',7X),/),/) 99 ENDIF 100 ENDDO 101 ENDIF 102 ENDDO 103 END 104 USE MAIN1 105 IF ( ICOUNT.NE.0 .AND. JCOUNT.NE.0 ) THEN 106 DO J = 1 , JCOUNT 107 DO I = 1 , ICOUNT 108 IF ( ISET.GT.NREC ) THEN 109 GOTO 999 110 ENDIF 111 ENDDO 112 ENDDO 113 ENDIF 114 999 CONTINUE 115 END 116