lecdon_tomawac.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\lecdon_tomawac.f
00002 !
00294                      SUBROUTINE LECDON_TOMAWAC
00295 !                    *************************
00296 !
00297      & (FILE_DESC,PATH,NCAR,CODE)
00298 !
00299 !***********************************************************************
00300 ! TOMAWAC   V7P0                                  25/06/2012
00301 !***********************************************************************
00302 !
00303 !
00304 !
00305 !
00306 !
00307 !
00308 !
00309 !
00310 !
00311 !
00312 !
00313 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00314 !| CODE           |-->| NAME OF CALLING PROGRAMME
00315 !| FILE_DESC      |-->| STORES THE FILES 'SUBMIT' ATTRIBUTES
00316 !|                |   | IN DICTIONARIES. IT IS FILLED BY DAMOCLES.
00317 !| NCAR           |-->| LENGTH OF PATH
00318 !| PATH           |-->| NAME OF CURRENT DIRECTORY
00319 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00320 !
00321       USE BIEF
00322       USE DECLARATIONS_TELEMAC
00323       USE DECLARATIONS_TOMAWAC
00324 !
00325       IMPLICIT NONE
00326 !
00327       INTEGER LNG,LU
00328       COMMON/INFO/LNG,LU
00329 !
00330 !-----------------------------------------------------------------------
00331 !
00332       CHARACTER*8      MNEMO(MAXVAR)
00333       INTEGER          K
00334 !
00335 !-----------------------------------------------------------------------
00336 !
00337 ! ARRAYS USED IN THE DAMOCLES CALL
00338 !
00339       INTEGER, PARAMETER :: NMAX = 300
00340 !
00341       INTEGER            ADRESS(4,NMAX),DIMEN(4,NMAX)
00342       DOUBLE PRECISION   MOTREA(NMAX)
00343       INTEGER            MOTINT(NMAX)
00344       LOGICAL            MOTLOG(NMAX)
00345       CHARACTER(LEN=144) MOTCAR(NMAX)
00346       CHARACTER(LEN=72)  MOTCLE(4,NMAX,2)
00347       INTEGER            TROUVE(4,NMAX)
00348       LOGICAL            DOC
00349       CHARACTER(LEN=250) :: NOM_CAS
00350       CHARACTER(LEN=250) :: NOM_DIC
00351 ! ARGUMENTS
00352       CHARACTER(LEN=24), INTENT(IN)     :: CODE
00353       CHARACTER(LEN=144), INTENT(INOUT) :: FILE_DESC(4,NMAX)
00354       INTEGER, INTENT(IN)               :: NCAR
00355       CHARACTER(LEN=250), INTENT(IN)    :: PATH
00356       INTEGER :: I
00357 !
00358 ! END OF DECLARATIONS FOR DAMOCLES CALL
00359 !
00360 !
00361 !***********************************************************************
00362 !
00363       IF (LNG.EQ.1) WRITE(LU,1)
00364       IF (LNG.EQ.2) WRITE(LU,2)
00365 1     FORMAT(1X,/,19X, '********************************************',/,
00366      &            19X, '*     SOUS-PROGRAMME LECDON_TOMAWAC        *',/,
00367      &            19X, '*           APPEL DE DAMOCLES              *',/,
00368      &            19X, '*     VERIFICATION DES DONNEES LUES        *',/,
00369      &            19X, '*           SUR LE FICHIER CAS             *',/,
00370      &            19X, '********************************************',/)
00371 2     FORMAT(1X,/,19X, '********************************************',/,
00372      &            19X, '*        SUBROUTINE LECDON_TOMAWAC         *',/,
00373      &            19X, '*           CALL OF DAMOCLES               *',/,
00374      &            19X, '*        VERIFICATION OF READ DATA         *',/,
00375      &            19X, '*            ON STEERING FILE              *',/,
00376      &            19X, '********************************************',/)
00377 !
00378 !-----------------------------------------------------------------------
00379 !
00380 ! INITIALISES THE VARIABLES FOR DAMOCLES CALL :
00381 !
00382       DO K=1,NMAX
00383 !       A FILENAME NOT GIVEN BY DAMOCLES WILL BE RECOGNIZED AS A WHITE SPACE
00384 !       (IT MAY BE THAT NOT ALL COMPILERS WILL INITIALISE LIKE THAT)
00385         MOTCAR(K)(1:1)=' '
00386 !
00387         DIMEN(1,K) = 0
00388         DIMEN(2,K) = 0
00389         DIMEN(3,K) = 0
00390         DIMEN(4,K) = 0
00391       ENDDO
00392 !
00393 !     WRITES OUT INFO
00394       DOC = .FALSE.
00395 !
00396 !-----------------------------------------------------------------------
00397 !     OPENS DICTIONNARY AND STEERING FILES
00398 !-----------------------------------------------------------------------
00399 !
00400       IF(NCAR.GT.0) THEN
00401 !
00402         NOM_DIC=PATH(1:NCAR)//'WACDICO'
00403         NOM_CAS=PATH(1:NCAR)//'WACCAS'
00404 !
00405       ELSE
00406 !
00407         NOM_DIC='WACDICO'
00408         NOM_CAS='WACCAS'
00409 !
00410       ENDIF
00411 !
00412       OPEN(2,FILE=NOM_DIC,FORM='FORMATTED',ACTION='READ')
00413       OPEN(3,FILE=NOM_CAS,FORM='FORMATTED',ACTION='READ')
00414 !
00415       CALL DAMOCLE
00416      &( ADRESS, DIMEN , NMAX  , DOC    , LNG   , LU    , MOTINT,
00417      &  MOTREA, MOTLOG, MOTCAR, MOTCLE , TROUVE, 2  , 3  ,
00418      &  .FALSE.,FILE_DESC)
00419 !
00420 !     DECODES 'SUBMIT' CHAINS
00421 !
00422       CALL READ_SUBMIT(WAC_FILES,MAXLU_WAC,CODE,FILE_DESC,300)
00423 !
00424 !-----------------------------------------------------------------------
00425 !
00426 !     RETRIEVES FILE NUMBERS FROM TOMAWAC FORTRAN PARAMETERS
00427 !     AT THIS LEVEL LOGICAL UNITS ARE EQUAL TO THE FILE NUMBER
00428 !
00429       DO I=1,MAXLU_WAC
00430         IF(WAC_FILES(I)%TELNAME.EQ.'WACGEO') THEN
00431           WACGEO=I
00432         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACCAS') THEN
00433           WACCAS=I
00434         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACCLI') THEN
00435           WACCLI=I
00436         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACFON') THEN
00437           WACFON=I
00438         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACRES') THEN
00439           WACRES=I
00440         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACREF') THEN
00441           WACREF=I
00442         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACSPE') THEN
00443           WACSPE=I
00444         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACLEO') THEN
00445           WACLEO=I
00446         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACPRE') THEN
00447           WACPRE=I
00448         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACRBI') THEN
00449           WACRBI=I
00450         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACCOB') THEN
00451           WACCOB=I
00452         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACCOF') THEN
00453           WACCOF=I
00454         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACBI1') THEN
00455           WACBI1=I
00456         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACFO1') THEN
00457           WACFO1=I
00458         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACVEB') THEN
00459           WACVEB=I
00460         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACVEF') THEN
00461           WACVEF=I
00462         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACPAR') THEN
00463           WACPAR=I
00464         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACMAB') THEN
00465           WACMAB=I
00466         ELSEIF(WAC_FILES(I)%TELNAME.EQ.'WACMAF') THEN
00467           WACMAF=I
00468         ENDIF
00469       ENDDO
00470 !
00471 !-----------------------------------------------------------------------
00472 !
00473 !     SETTING CONSTANTS (PI, GRAVITY, ETC.)
00474 !
00475       CALL TOMAWAC_CONSTANTS
00476 !
00477 !-----------------------------------------------------------------------
00478 !
00479 !     ASSIGNS THE STEERING FILE VALUES TO THE PARAMETER FORTRAN NAME
00480 !
00481 !-----------------------------------------------------------------------
00482 !
00483 !     INTEGER KEYWORDS
00484 !
00485       GRAPRD = MOTINT( ADRESS(1,  1) )
00486       LISPRD = MOTINT( ADRESS(1,  2) )
00487       NIT    = MOTINT( ADRESS(1,  3) )
00488       NPLAN  = MOTINT( ADRESS(1,  4) )
00489       NF     = MOTINT( ADRESS(1,  5) )
00490       GRADEB = MOTINT( ADRESS(1,  6) )
00491       LISFON = MOTINT( ADRESS(1,  7) )
00492       SVENT  = MOTINT( ADRESS(1,  8) )
00493       SMOUT  = MOTINT( ADRESS(1,  9) )
00494       SFROT  = MOTINT( ADRESS(1, 10) )
00495       STRIF  = MOTINT( ADRESS(1, 11) )
00496       INDIC  = MOTINT( ADRESS(1, 12) )
00497       INDIV  = MOTINT( ADRESS(1, 13) )
00498       NSITS  = MOTINT( ADRESS(1, 14) )
00499       INISPE = MOTINT( ADRESS(1, 15) )
00500 !     DISSIPATION BY STRONG CURRENT
00501       SDSCU  = MOTINT( ADRESS(1, 16) )
00502       NPTT   = MOTINT( ADRESS(1, 17) )
00503       LVMAC  = MOTINT( ADRESS(1, 18) )
00504       SBREK  = MOTINT( ADRESS(1, 19) )
00505       IQBBJ  = MOTINT( ADRESS(1, 20) )
00506       IHMBJ  = MOTINT( ADRESS(1, 21) )
00507       IFRBJ  = MOTINT( ADRESS(1, 22) )
00508       IWHTG  = MOTINT( ADRESS(1, 23) )
00509       IFRTG  = MOTINT( ADRESS(1, 24) )
00510       IDISRO = MOTINT( ADRESS(1, 25) )
00511       IEXPRO = MOTINT( ADRESS(1, 26) )
00512       IFRRO  = MOTINT( ADRESS(1, 27) )
00513       IFRIH  = MOTINT( ADRESS(1, 28) )
00514       NDTBRK = MOTINT( ADRESS(1, 29) )
00515       LIMIT  = MOTINT( ADRESS(1, 30) )
00516 !GM V6P1 - NEW SOURCE TERMS
00517       LVENT  = MOTINT( ADRESS(1, 31) )
00518 !GM Fin
00519       STRIA  = MOTINT( ADRESS(1, 32) )
00520       LIMSPE = MOTINT( ADRESS(1, 33) )
00521       LAM    = MOTINT( ADRESS(1, 34) )
00522       INDIM  = MOTINT( ADRESS(1, 35) )
00523       IDHMA  = MOTINT( ADRESS(1, 36) )
00524       FRABI  = MOTINT( ADRESS(1, 37) )
00525       NPRIV  = MOTINT( ADRESS(1, 38) )
00526       FRABL  = MOTINT( ADRESS(1, 39) )
00527 !     COORDINATES OF THE ORIGIN IN (X, Y)
00528       I_ORIG = MOTINT( ADRESS(1, 40) )
00529       J_ORIG = MOTINT( ADRESS(1, 40)+1 )
00530 !     DEBUG KEYWORD
00531       DEBUG  = MOTINT( ADRESS(1, 41) )
00532 !GM V6P1 - NEW SOURCE TERMS
00533       IQ_OM1 = MOTINT( ADRESS(1, 42) )
00534       NQ_TE1 = MOTINT( ADRESS(1, 43) )
00535       NQ_OM2 = MOTINT( ADRESS(1, 44) )
00536 !GM Fin
00537 !V6P2 Diffraction
00538       DIFFRA = MOTINT( ADRESS(1, 45) )
00539       NPTDIF = MOTINT( ADRESS(1, 46) )
00540 !V6P2 End diffraction
00541 !     GEOMETRY FILE STANDARD
00542       STDGEO = 3
00543 !
00544       DIAGHF = MOTINT( ADRESS(1, 47) )
00545 !
00546 !     OPTION FOR SECOND DERIVATIVES
00547 !
00548       OPTDER = MOTINT( ADRESS(1, 48) )
00549 !
00550 !     49 IS PARALLEL PROCESSORS
00551 !
00552 !     PARALLEL ASSEMBLY MODE
00553 !
00554       MODASS = MOTINT( ADRESS(1, 50) )
00555 !
00556 ! REAL KEYWORDS
00557 !
00558       DT     = MOTREA( ADRESS(2,  1) )
00559       F1     = MOTREA( ADRESS(2,  2) )
00560       RAISF  = MOTREA( ADRESS(2,  3) )
00561       IF(DIMEN(2,4).NE.DIMEN(2,5)) THEN
00562         IF(LNG.EQ.1) THEN
00563           WRITE(LU,*) 'ABSCISSES ET ORDONNEES DES POINTS DE SORTIE'
00564           WRITE(LU,*) 'DU SPECTRE DOIVENT ETRE DONNEES EN NOMBRE'
00565           WRITE(LU,*) 'EGAL, OR IL Y A ',DIMEN(2,4),' ABSCISSES ET '
00566           WRITE(LU,*) DIMEN(2,5),' ORDONNEES'
00567         ENDIF
00568         IF(LNG.EQ.2) THEN
00569           WRITE(LU,*) 'ABSCISSAE AND ORDINATES OF SPECTRUM PRINTOUT'
00570           WRITE(LU,*) 'POINTS MUST BE GIVEN IN EQUAL NUMBERS'
00571           WRITE(LU,*) 'THERE ARE HERE',DIMEN(2,4),' ABCISSAE AND '
00572           WRITE(LU,*) DIMEN(2,5),' ORDINATES'
00573         ENDIF
00574         CALL PLANTE(1)
00575         STOP
00576       ENDIF
00577       NPLEO  = DIMEN(2,4)
00578       DO K=1,DIMEN(2,4)
00579         XLEO(K)= MOTREA( ADRESS(2,  4) + K-1)
00580       ENDDO
00581       DO K=1,DIMEN(2,5)
00582         YLEO(K)= MOTREA( ADRESS(2,  5) + K-1)
00583       ENDDO
00584       DDC    = MOTREA( ADRESS(2,  6) )
00585       CFROT1 = MOTREA( ADRESS(2,  7) )
00586       CMOUT1 = MOTREA( ADRESS(2,  8) )
00587       CMOUT2 = MOTREA( ADRESS(2,  9) )
00588       ROAIR  = MOTREA( ADRESS(2, 10) )
00589       ROEAU  = MOTREA( ADRESS(2, 11) )
00590       BETAM  = MOTREA( ADRESS(2, 12) )
00591       XKAPPA = MOTREA( ADRESS(2, 13) )
00592       ALPHA  = MOTREA( ADRESS(2, 14) )
00593       DECAL  = MOTREA( ADRESS(2, 15) )
00594       ZVENT  = MOTREA( ADRESS(2, 16) )
00595       CDRAG  = MOTREA( ADRESS(2, 17) )
00596       HM0    = MOTREA( ADRESS(2, 18) )
00597       FPIC   = MOTREA( ADRESS(2, 19) )
00598       GAMMA  = MOTREA( ADRESS(2, 20) )
00599       SIGMAA = MOTREA( ADRESS(2, 21) )
00600       SIGMAB = MOTREA( ADRESS(2, 22) )
00601       ALPHIL = MOTREA( ADRESS(2, 23) )
00602       FETCH  = MOTREA( ADRESS(2, 24) )
00603       FREMAX = MOTREA( ADRESS(2, 25) )
00604       TETA1  = MOTREA( ADRESS(2, 26) )*DEGRAD
00605       SPRED1 = MOTREA( ADRESS(2, 27) )
00606       TETA2  = MOTREA( ADRESS(2, 28) )*DEGRAD
00607       SPRED2 = MOTREA( ADRESS(2, 29) )
00608       XLAMDA = MOTREA( ADRESS(2, 30) )
00609       TAILF  = MOTREA( ADRESS(2, 31) )
00610       E2FMIN = MOTREA( ADRESS(2, 32) )
00611       ALFABJ = MOTREA( ADRESS(2, 33) )
00612       GAMBJ1 = MOTREA( ADRESS(2, 34) )
00613       GAMBJ2 = MOTREA( ADRESS(2, 35) )
00614       BORETG = MOTREA( ADRESS(2, 36) )
00615       GAMATG = MOTREA( ADRESS(2, 37) )
00616       ALFARO = MOTREA( ADRESS(2, 38) )
00617       GAMARO = MOTREA( ADRESS(2, 39) )
00618       GAM2RO = MOTREA( ADRESS(2, 40) )
00619       BETAIH = MOTREA( ADRESS(2, 41) )
00620       EM2SIH = MOTREA( ADRESS(2, 42) )
00621       COEFHS = MOTREA( ADRESS(2, 43) )
00622       XDTBRK = MOTREA( ADRESS(2, 44) )
00623       XLAMD  = MOTREA( ADRESS(2, 45) )
00624       ZREPOS = MOTREA( ADRESS(2, 46) )
00625       ALFLTA = MOTREA( ADRESS(2, 47) )
00626       RFMLTA = MOTREA( ADRESS(2, 48) )
00627       KSPB   = MOTREA( ADRESS(2, 49) )
00628       BDISPB = MOTREA( ADRESS(2, 50) )*DEGRAD
00629       BDSSPB = MOTREA( ADRESS(2, 51) )*DEGRAD
00630       HM0L   = MOTREA( ADRESS(2, 52) )
00631       FPICL  = MOTREA( ADRESS(2, 53) )
00632       SIGMAL = MOTREA( ADRESS(2, 54) )
00633       SIGMBL = MOTREA( ADRESS(2, 55) )
00634       APHILL = MOTREA( ADRESS(2, 56) )
00635       FETCHL = MOTREA( ADRESS(2, 57) )
00636       FPMAXL = MOTREA( ADRESS(2, 58) )
00637       TETA1L = MOTREA( ADRESS(2, 59) )*DEGRAD
00638       SPRE1L = MOTREA( ADRESS(2, 60) )
00639       TETA2L = MOTREA( ADRESS(2, 61) )*DEGRAD
00640       SPRE2L = MOTREA( ADRESS(2, 62) )
00641       XLAMDL = MOTREA( ADRESS(2, 63) )
00642       GAMMAL = MOTREA( ADRESS(2, 64) )
00643       PROMIN = MOTREA( ADRESS(2, 65) )
00644       VX_CTE = MOTREA( ADRESS(2, 66) )
00645       VY_CTE = MOTREA( ADRESS(2, 67) )
00646       CIMPLI = MOTREA( ADRESS(2, 68) )
00647       COEFWD = MOTREA( ADRESS(2, 69) )
00648       COEFWE = MOTREA( ADRESS(2, 70) )
00649       COEFWF = MOTREA( ADRESS(2, 71) )
00650       COEFWH = MOTREA( ADRESS(2, 72) )
00651       CMOUT3 = MOTREA( ADRESS(2, 73) )
00652       CMOUT4 = MOTREA( ADRESS(2, 74) )
00653       CMOUT5 = MOTREA( ADRESS(2, 75) )
00654       CMOUT6 = MOTREA( ADRESS(2, 76) )
00655       SEUIL  = MOTREA( ADRESS(2, 77) )
00656       SEUIL1 = MOTREA( ADRESS(2, 78) )
00657       SEUIL2 = MOTREA( ADRESS(2, 79) )
00658       F2DIFM = MOTREA( ADRESS(2, 80) )
00659 !     TIME UNITS IN FILES
00660       UNITCOB= MOTREA( ADRESS(2, 81) )
00661       UNITMAB= MOTREA( ADRESS(2, 82) )
00662       UNITVEB= MOTREA( ADRESS(2, 83) )
00663 !     TIME SHIFTS IN FILES
00664       PHASCOB= MOTREA( ADRESS(2, 84) )
00665       PHASMAB= MOTREA( ADRESS(2, 85) )
00666       PHASVEB= MOTREA( ADRESS(2, 86) )
00667 !     DISSIPATION COEFFICIENT FOR STRONG CURRENT
00668       CDSCUR = MOTREA( ADRESS(2, 87) )
00669 !
00670 ! LOGICAL KEYWORDS
00671 !
00672       TSOU   = MOTLOG( ADRESS(3,  1) )
00673       SPHE   = MOTLOG( ADRESS(3,  2) )
00674       GLOB   = MOTLOG( ADRESS(3,  3) )
00675       SUIT   = MOTLOG( ADRESS(3,  4) )
00676       PROINF = MOTLOG( ADRESS(3,  5) )
00677       COUSTA = MOTLOG( ADRESS(3,  6) )
00678       VENT   = MOTLOG( ADRESS(3,  7) )
00679       DONTEL = MOTLOG( ADRESS(3,  8) )
00680       PROP   = MOTLOG( ADRESS(3,  9) )
00681       VENSTA = MOTLOG( ADRESS(3, 10) )
00682       VALID  = MOTLOG( ADRESS(3, 11) )
00683       MAREE  = MOTLOG( ADRESS(3, 12) )
00684       TRIGO  = MOTLOG( ADRESS(3, 13) )
00685       SPEULI = MOTLOG( ADRESS(3, 14) )
00686       FLTDIF = MOTLOG( ADRESS(3, 15) )
00687       RAZTIM = MOTLOG( ADRESS(3, 16) )
00688       VEGETATION = MOTLOG( ADRESS(3, 17) )
00689 !
00690 ! STRING KEYWORDS
00691 !
00692       TITCAS = MOTCAR( ADRESS(4, 1) ) (1:72)
00693       SORT2D = MOTCAR( ADRESS(4, 2) ) (1:72)
00694 !
00695 ! FILES IN THE STEERING FILE
00696 !
00697       WAC_FILES(WACGEO)%NAME=MOTCAR( ADRESS(4,3) )
00698 !     NOMFOR = MOTCAR( ADRESS(4, 4) )
00699 !     NOMCAS = MOTCAR( ADRESS(4, 5) )
00700       WAC_FILES(WACCLI)%NAME=MOTCAR( ADRESS(4,6) )
00701       WAC_FILES(WACFON)%NAME=MOTCAR( ADRESS(4,7) )
00702       WAC_FILES(WACRES)%NAME=MOTCAR( ADRESS(4,8) )
00703       WAC_FILES(WACLEO)%NAME=MOTCAR( ADRESS(4,9) )
00704       WAC_FILES(WACPRE)%NAME=MOTCAR( ADRESS(4,10) )
00705       WAC_FILES(WACRBI)%NAME=MOTCAR( ADRESS(4,11) )
00706       WAC_FILES(WACCOB)%NAME=MOTCAR( ADRESS(4,12) )
00707       WAC_FILES(WACCOF)%NAME=MOTCAR( ADRESS(4,13) )
00708       WAC_FILES(WACBI1)%NAME=MOTCAR( ADRESS(4,14) )
00709       WAC_FILES(WACFO1)%NAME=MOTCAR( ADRESS(4,15) )
00710       BINGEO = MOTCAR( ADRESS(4,16) )(1:3)
00711       BINRES = MOTCAR( ADRESS(4,17) )(1:3)
00712       BINLEO = MOTCAR( ADRESS(4,18) )(1:3)
00713       BINCOU = MOTCAR( ADRESS(4,19) )(1:3)
00714       BINRBI = MOTCAR( ADRESS(4,20) )(1:3)
00715       BINPRE = MOTCAR( ADRESS(4,21) )(1:3)
00716       VERS   = MOTCAR( ADRESS(4,22) )(1:4)
00717 !
00718 !     FROM 23 TO 28 : FOR CRAY, NOT USEFUL HERE
00719 !
00720       BINVEN = MOTCAR( ADRESS(4,29) )(1:3)
00721       BINBI1 = MOTCAR( ADRESS(4,30) )(1:3)
00722       WAC_FILES(WACVEB)%NAME=MOTCAR( ADRESS(4,31) )
00723       WAC_FILES(WACVEF)%NAME=MOTCAR( ADRESS(4,32) )
00724       WAC_FILES(WACPAR)%NAME=MOTCAR( ADRESS(4,33) )
00725       WAC_FILES(WACREF)%NAME=MOTCAR( ADRESS(4,34) )
00726       WAC_FILES(WACMAB)%NAME=MOTCAR( ADRESS(4,35) )
00727       WAC_FILES(WACMAF)%NAME=MOTCAR( ADRESS(4,36) )
00728       BINMAR = MOTCAR( ADRESS(4,37) )(1:3)
00729       EQUA   = 'TOMAWAC-COWADIS'
00730 !BD_INCKA FILE FORMATS
00731 !     GEOMETRY FILE
00732       WAC_FILES(WACGEO)%FMT = MOTCAR( ADRESS(4,39) )(1:8)
00733       CALL MAJUS(WAC_FILES(WACGEO)%FMT)
00734 !     RESULTS FILE FORMAT
00735       WAC_FILES(WACRES)%FMT = MOTCAR( ADRESS(4,40) )(1:8)
00736       CALL MAJUS(WAC_FILES(WACRES)%FMT)
00737 !     INITIAL RESULTS FILE FORMAT (< PREVIOUS COMPUTATION)
00738 !     SEDIMENT...
00739       WAC_FILES(WACPRE)%FMT = MOTCAR( ADRESS(4,41) )(1:8)
00740       CALL MAJUS(WAC_FILES(WACPRE)%FMT)
00741 !     REFERENCE FILE FORMAT
00742       WAC_FILES(WACREF)%FMT = MOTCAR( ADRESS(4,42) )(1:8)
00743       CALL MAJUS(WAC_FILES(WACREF)%FMT)
00744 !     BINARY FILE 1 FORMAT
00745       WAC_FILES(WACBI1)%FMT = MOTCAR( ADRESS(4,43) )(1:8)
00746       CALL MAJUS(WAC_FILES(WACBI1)%FMT)
00747 !     SPECTRAL FILE FORMAT
00748       WAC_FILES(WACLEO)%FMT = MOTCAR( ADRESS(4,44) )(1:8)
00749       CALL MAJUS(WAC_FILES(WACLEO)%FMT)
00750 !
00751 !     NAMES OF VARIABLES
00752 !
00753       NAMEU =MOTCAR( ADRESS(4,45)   )(1:32)
00754       NAMEV =MOTCAR( ADRESS(4,45)+1 )(1:32)
00755       NAMEWX=MOTCAR( ADRESS(4,45)+2 )(1:32)
00756       NAMEWY=MOTCAR( ADRESS(4,45)+3 )(1:32)
00757       NAMEH =MOTCAR( ADRESS(4,45)+4 )(1:32)
00758 !
00759       WAC_FILES(WACSPE)%NAME=MOTCAR( ADRESS(4,50) )
00760 !
00761 !     CORRECTS OR COMPUTES OTHER PARAMETERS FROM THOSE THAT
00762 !     HAVE JUST BEEN READ
00763 !
00764       IF(COUSTA.OR.MAREE) THEN
00765         COURAN=.TRUE.
00766       ELSE
00767         COURAN=.FALSE.
00768       ENDIF
00769       IF(.NOT.VENT.AND.SVENT.NE.0) THEN
00770         IF(LNG.EQ.1)
00771      &        WRITE(LU,*)
00772      &     'INCOHERENCE DES MOTS CLES DU VENT => PAS DE VENT'
00773         IF(LNG.EQ.2)
00774      &        WRITE(LU,*)
00775      &     
00776 'INCOMPATIBILITY OF KEY-WORDS CONCERNING WIND => NO     &      WIND'
00777         SVENT=0
00778       ENDIF
00779       IF(TRIGO) THEN
00780         TETA1  = PISUR2-TETA1
00781         TETA2  = PISUR2-TETA2
00782         TETA1L = PISUR2-TETA1L
00783         TETA2L = PISUR2-TETA2L
00784         BDISPB = PISUR2-BDISPB
00785         BDSSPB = PISUR2-BDSSPB
00786       ENDIF
00787       IF(CIMPLI.LT.0.OR.CIMPLI.GT.1) THEN
00788         IF(LNG.EQ.1) THEN
00789           WRITE(LU,*) 'INCOHERENCE DU COEFFICIENT D IMPLICITATION'
00790           WRITE(LU,*) 'VALEUR LUE = ',CIMPLI
00791           WRITE(LU,*) 'ON PREND LA VALEUR PAR DEFAUT CIMPLI=0.5'
00792         ENDIF
00793         IF(LNG.EQ.2) THEN
00794           WRITE(LU,*) 'INCOMPATIBILITY OF IMPLICITATION COEFFICIENT'
00795           WRITE(LU,*) 'VALUE READ = ',CIMPLI
00796           WRITE(LU,*) 'WE TAKE THE DEFAULT VALUE CIMPLI=0.5'
00797         ENDIF
00798         CIMPLI=0.5D0
00799       ENDIF
00800 !GM V6P1 - NEW SOURCE TERMS
00801       IF(.NOT.PROINF.AND.STRIF.EQ.3) THEN
00802         IF(LNG.EQ.1) THEN
00803           WRITE(LU,*) 'INCOHERENCE DE LA PROFONDEUR ET DU'
00804           WRITE(LU,*) 'TERME DE TRANSFERT NON LINEAIRE'
00805         ENDIF
00806         IF(LNG.EQ.2) THEN
00807           WRITE(LU,*) 'INCOMPATIBILITY OF DEPTH AND'
00808           WRITE(LU,*) 'NON-LINEAR TRANSFER TERM'
00809         ENDIF
00810         CALL PLANTE(1)
00811         STOP
00812       ENDIF
00813 !GM Fin
00814 !
00815 !
00816 !-----------------------------------------------------------------------
00817 !  NAME OF THE VARIABLES FOR THE RESULTS AND GEOMETRY FILES:
00818 !-----------------------------------------------------------------------
00819 !
00820 ! LOGICAL ARRAY FOR OUTPUT
00821 !
00822       CALL NOMVAR_TOMAWAC(TEXTE,TEXTPR,MNEMO,MAXVAR)
00823 !
00824 !$DC$ BUG : ARRAYS MNEMO AND SORLEO OF SIZE MAXVAR
00825 !             MUCH LESS THAN 100 !
00826       CALL SORTIE(SORT2D , MNEMO , MAXVAR , SORLEO )
00827 !
00828 !.....IF NO WIND, THERE SHOULD BE NO INFORMATION WRITTEN ABOUT WINDS
00829       IF (.NOT.VENT) THEN
00830         SORLEO( 9)=.FALSE.
00831         SORLEO(10)=.FALSE.
00832       ENDIF
00833 !
00834 !.....IF INFINITE DEPTH, THE RADIATION STRESSES ARE NOT COMPUTED
00835       IF (PROINF) THEN
00836         IF (SORLEO(11) .OR. SORLEO(12) .OR. SORLEO(13) .OR.
00837      &      SORLEO(14) .OR. SORLEO(15) ) THEN
00838            IF (LNG.EQ.1) THEN
00839              WRITE(LU,*) '******************************************'
00840              WRITE(LU,*) ' LE CALCUL DES CONTRAINTES DE RADIATION ET'
00841              WRITE(LU,*) '  DES FORCES MOTRICES NE S''EFFECTUE PAS'
00842              WRITE(LU,*) '      PAS EN PROFONDEUR INFINIE          '
00843              WRITE(LU,*) '******************************************'
00844            ELSE
00845              WRITE(LU,*) '*****************************************'
00846              WRITE(LU,*) '   RADIATION STRESSES ARE NOT COMPUTED  '
00847              WRITE(LU,*) '       OVER INFINITE WATER DEPTHS       '
00848              WRITE(LU,*) '******************************************'
00849            ENDIF
00850            DO K=11,15
00851              SORLEO(K) = .FALSE.
00852            ENDDO
00853         ENDIF
00854       ENDIF
00855 !
00856       DO K=1,MAXVAR
00857         SORIMP(K)=.FALSE.
00858       ENDDO
00859 !
00860 !-----------------------------------------------------------------------
00861 !
00862       RETURN
00863       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0