artemis.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\artemis.f
00002 !
00181                      SUBROUTINE ARTEMIS
00182 !                    ******************
00183 !
00184 !
00185 !***********************************************************************
00186 ! ARTEMIS   V6P3                                   21/08/2010
00187 !***********************************************************************
00188 !
00189 !
00190 !
00191 !
00192 !
00193 !
00194 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00195 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00196 !
00197       USE BIEF
00198       USE DECLARATIONS_TELEMAC
00199       USE DECLARATIONS_ARTEMIS
00200       USE GRACESTOP
00201 !
00202 !-----------------------------------------------------------------------
00203 ! DECLARES TYPES AND DIMENSIONS
00204 !-----------------------------------------------------------------------
00205 !
00206       IMPLICIT NONE
00207       INTEGER LNG,LU
00208       COMMON/INFO/LNG,LU
00209 !
00210 ! INTEGERS
00211 !
00212       INTEGER LT,NPERBA,ITERMUR, I , LF
00213       INTEGER NELBRD,NPFMAX,NELBRX
00214 !      INTEGER LPER,LDIR
00215       INTEGER ALIRE(MAXVAR)
00216 !
00217 ! VARIABLE FOR SUBROUTINE DISMOY
00218 !
00219       INTEGER LISHHO
00220 !
00221 ! REAL SCALARS
00222 !
00223       DOUBLE PRECISION RADDEG,HIST(1)
00224 !
00225 ! VARIABLES FOR CALLS TO TELEMAC-2D SUBROUTINES
00226 !
00227       INTEGER NVARCL,ISTO
00228       DOUBLE PRECISION LAMBD0
00229       LOGICAL RESU,FROVAR,PROLIN,TRAC
00230 !
00231 ! USED FOR DUMMY ARGUMENTS
00232 !
00233       DOUBLE PRECISION BID,ECRHMU,MODHMU,PONDER
00234 !
00235       INTEGER  P_IMAX,P_IMIN
00236       DOUBLE PRECISION P_DMIN
00237       EXTERNAL P_IMAX,P_IMIN,P_DMIN
00238 !
00239       DATA HIST /9999.D0/
00240 !
00241 !-----------------------------------------------------------------------
00242 !
00243 !  VARIABLES TO READ IF COMPUTATION IS CONTINUED :
00244 !  0 : DISCARD    1 : READ  (SEE SUBROUTINE NOMVAR)
00245 !
00246       DATA ALIRE /1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
00247      &            0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
00248      &            0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
00249      &            0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/
00250 !
00251 !-----------------------------------------------------------------------
00252 !
00253       RADDEG = 180.D0/3.141592654D0
00254 !
00255 !
00256 !=======================================================================
00257 !
00258 ! : 1          READS, PREPARES AND CONTROLS THE DATA
00259 !
00260 !=======================================================================
00261 !
00262 !  TYPES OF DISCRETISATION:
00263 !
00264 !  TRIANGLES : P1
00265       IELM  = 11
00266 !  SEGMENTS  : P1 FOR THE BOUNDARY
00267       IELMB = 1
00268 !
00269 !
00270 !  MAXIMUM SIZE (CASE OF AN ADAPTIVE GRID)
00271 !  THESE PARAMETERS ARE USED IN BIEF CALLS
00272 !
00273 !     NODES
00274       NPMAX = NPOIN
00275 !     ELEMENTS
00276       NELMAX = NELEM
00277 !     BOUNDARY ELEMENTS
00278       NELBRD = NPTFR
00279 !     BOUNDARY ELEMENTS (MAXIMUM NUMBER)
00280       NPFMAX = NPTFR
00281 !     BOUNDARY NODES
00282       NELBRX = NPTFR
00283 !
00284       IF(BALAYE) THEN
00285         NPERBA = INT((PERFIN-PERDEB)/PERPAS) + 1
00286       ENDIF
00287 !
00288 !=======================================================================
00289 !
00290       RESU   = .TRUE.
00291       FROVAR = .FALSE.
00292       PROLIN = .FALSE.
00293       SPHERI = .FALSE.
00294       TRAC   = .FALSE.
00295       NVARCL = 0
00296 !
00297 ! IN TELEMAC-2D, LIHBOR = KINC IS AUTOMATICALLY CHANGED TO KSORT
00298 ! HAS TO MODIFY THE VALUE OF KINC FOR PREDA2, TO AVOID THIS AUTOMATIC CHANGE
00299 ! IN ADDITION, IN TELEMAC-2D, LIHBOR = KADH (NOT KNOWN HERE) GENERATES
00300 ! A MESSAGE. TO AVOID IT, ISTO IS ALSO USED IN PLACE OF KADH.
00301 !
00302 !
00303       ISTO = 100
00304 !
00305 !-----------------------------------------------------------------------
00306 !
00307 ! READS THE BOUNDARY CONDITIONS AND INDICES FOR THE BOUNDARY NODES.
00308 !
00309 ! CCP : WARNING :
00310 !       V6P2 LECLIM_ARTEMIS IS NOT USED ANYMORE.
00311 !       IN LECLIM we use 0 0 0 0 0 0 values for KENT,KENTU, etc...
00312 !       This way LECLIM ONLY READ the boundary conditions file and
00313 !       DO NOT CHANGE the LIHBOR values
00314 !
00315       CALL LECLIM (LIHBOR%I   , LIUBOR%I , ITB1%I , ITB1%I,
00316      &             TB1%R      , TB1%R    , TB1%R  , TB1%R ,
00317      &             TB1%R      , TB1%R    , TB1%R  ,
00318      &             MESH%NPTFR , 3        ,.FALSE. ,
00319      &             ART_FILES(ARTCLI)%LU,
00320      &             0       , 0    , 0 ,  0 , 0 , 0,
00321      &             NUMLIQ%I   ,MESH,BOUNDARY_COLOUR%I)
00322 !
00323 !-----------------------------------------------------------------------
00324 !
00325 ! COMPLEMENTS THE DATA STRUCTURE FOR BIEF
00326 !
00327       CALL INBIEF(LIHBOR%I,KLOG,IT1,IT2,IT3,LVMAC,IELM,
00328      &         LAMBD0,SPHERI,MESH,T1,T2,OPTASS,PRODUC,EQUA)
00329 !-----------------------------------------------------------------------
00330 !  LOOKS FOR BOTTOM AND BOTTOM FRICTION IN THE GEOMETRY FILE :
00331 !-----------------------------------------------------------------------
00332 !
00333       CALL FONSTR(T1,ZF,T2,FW,ART_FILES(ARTGEO)%LU,
00334      &            ART_FILES(ARTGEO)%FMT,ART_FILES(ARTFON)%LU,
00335      &            ART_FILES(ARTFON)%NAME,MESH,FFON,LISTIN)
00336 !-----------------------------------------------------------------------
00337 !
00338 ! PREPARES THE RESULTS FILE (OPTIONAL)
00339 !
00340 !     STANDARD SELAFIN FORMAT
00341 !
00342         ! CREATES DATA FILE USING A GIVEN FILE FORMAT : FORMAT_RES.
00343         ! THE DATA ARE CREATED IN THE FILE: NRES, AND ARE
00344         ! CHARACTERISED BY A TITLE AND NAME OF OUTPUT VARIABLES
00345         ! CONTAINED IN THE FILE.
00346         CALL CREATE_DATASET(ART_FILES(ARTRES)%FMT, ! RESULTS FILE FORMAT
00347      &                      ART_FILES(ARTRES)%LU,  ! LU FOR RESULTS FILE
00348      &                      TITCAS,     ! TITLE
00349      &                      MAXVAR,     ! MAX NUMBER OF OUTPUT VARIABLES
00350      &                      TEXTE,      ! NAMES OF OUTPUT VARIABLES
00351      &                      SORLEO)     ! PRINT TO FILE OR NOT
00352         ! WRITES THE MESH IN THE OUTPUT FILE :
00353         ! IN PARALLEL, REQUIRES NCSIZE AND NPTIR.
00354         ! THE REST OF THE INFORMATION IS IN MESH.
00355         ! ALSO WRITES : START DATE/TIME AND COORDINATES OF THE
00356         ! ORIGIN.
00357         CALL WRITE_MESH(ART_FILES(ARTRES)%FMT, ! RESULTS FILE FORMAT
00358      &                  ART_FILES(ARTRES)%LU,  ! LU FOR RESULTS FILE
00359      &                  MESH,          ! CHARACTERISES MESH
00360      &                  1,             ! NUMBER OF PLANES /NA/
00361      &                  MARDAT,        ! START DATE
00362      &                  MARTIM,        ! START TIME
00363      &                  I_ORIG,J_ORIG) ! COORDINATES OF THE ORIGIN.
00364 !
00365 !-----------------------------------------------------------------------
00366 !
00367 !     INITIALISES PRIVE
00368 !
00369       IF(NPRIV.GT.0) CALL OS('X=C     ',PRIVE,PRIVE,PRIVE,0.D0)
00370 !
00371 !=======================================================================
00372 !
00373       IF(NCSIZE.GT.1) THEN
00374         NFRLIQ=0
00375         DO I=1,NPTFR
00376           NFRLIQ=MAX(NFRLIQ,NUMLIQ%I(I))
00377         ENDDO
00378         NFRLIQ=P_IMAX(NFRLIQ)
00379         WRITE(LU,*) ' '
00380         IF(LNG.EQ.1) WRITE(LU,*) 'NOMBRE DE FRONTIERES LIQUIDES :',
00381      &        NFRLIQ
00382         IF(LNG.EQ.2) WRITE(LU,*) 'NUMBER OF LIQUID BOUNDARIES:',NFRLIQ
00383       ELSE
00384         CALL FRONT2(NFRLIQ,NFRSOL,DEBLIQ,FINLIQ,DEBSOL,FINSOL,
00385      &        LIHBOR%I,LIUBOR%I,
00386      &        MESH%X%R,MESH%Y%R,MESH%NBOR%I,MESH%KP1BOR%I,
00387      &        IT1%I,NPOIN,NPTFR,KLOG,LISTIN,NUMLIQ%I,MAXFRO)
00388       ENDIF
00389 ! LOCATES THE BOUNDARIES
00390 !
00391 !=======================================================================
00392 !
00393 ! CORRECTS THE VALUES OF THE BOTTOM (OPTIONAL)
00394 !
00395 ! STANDARD SUBROUTINE DOES NOT DO ANYTHING
00396 !
00397       CALL ART_CORFON
00398 !
00399 !-----------------------------------------------------------------------
00400 !
00401 !     READ TOMAWAC SPECTRUM IF NECESSARY
00402 !
00403       IF (CHAINTWC.AND.(.NOT.ALEMUL)) THEN
00404         WRITE(6,*) 
00405 'CHAINING WITH TOMAWAC NEEDS MULTIDIRECTIONAL     &                    RAMDOM SEA OPTION                          '
00406         CALL PLANTE(0)
00407       ENDIF
00408       IF (CHAINTWC) THEN
00409         CALL LECWAC1
00410       ENDIF
00411 !
00412 !=======================================================================
00413 !
00414 !=======================================================================
00415 !
00416 ! INITIALISES THE WAVE HEIGHT FOR RANDOM SEAS AT 0.
00417 !
00418       IF (ALEMON .OR. ALEMUL) THEN
00419         CALL OS('X=C     ', HALE , SBID , SBID , 0.D0 )
00420       ENDIF
00421 !
00422 !
00423 ! DETERMINES THE DIFFERENT DIRECTIONS FOR A MULTIDIRECTIONAL RANDOM
00424 ! SEA COMPUTATION
00425 !
00426 !     IF SPECTRUM TAKEN FROM TOMAWAC
00427       IF (CHAINTWC) THEN
00428         CALL TWCALE
00429 !            (DALE%R,PDALE%R,PMAX,PMIN,TETMAX,TETMIN,NPALE,NDALE)
00430         PER=PDALE%R(1)
00431         DO I=1,NPALE
00432           PALE%R(I)=PDALE%R(I)
00433         ENDDO
00434       ELSE
00435 !     IF JONSWAP SPECTRUM COMPUTED BY ARTEMIS
00436         IF (ALEMUL) THEN
00437           CALL DIRALE(DALE%R,EXPOS,TETAH,TETMIN,TETMAX,NDALE,
00438      &               T1%R,NPOIN,PRIVE,NPRIV)
00439         ENDIF
00440 !
00441 !
00442 !
00443 !       DETERMINES THE DIFFERENT PERIODS FOR A RANDOM SEA COMPUTATION
00444 !
00445         IF (ALEMON.OR.ALEMUL) THEN
00446           CALL PERALE(PALE%R,GAMMA,PERPIC,NPALE,T1%R,NPOIN,PRIVE,
00447      &               NPRIV,PMIN,PMAX)
00448           PER = PALE%R(1)
00449         ENDIF
00450 !
00451       ENDIF
00452 !
00453 !=======================================================================
00454 !
00455 ! START OF COMPUTATION
00456 !
00457 ! LT REFERS TO THE CURRENT CALCULATION
00458 !  (STARTS FROM 0 SO THAT THE FIRST COMPUTATION ALWAYS BE RECORDED)
00459 !  (ENDS AT NDALE x NPALE -1 SO THAT ALL DIRECTION AND FREQUENCIES ARE SOLVED)
00460       LT  = 0
00461 ! FOR A RANDOM SEA COMPUTATION, LPER AND LDIR REFER TO THE COMPUTED
00462 ! PERIOD AND DIRECTION. LT COUNT THE NUMBER OF BERKHOFF RESOLUTION
00463       LPER= 1
00464       LDIR= 1
00465 !
00466 ! LF =0 INDICATES IF THIS IS THE FIRST CALCULATION OF RANDOM SEA
00467 ! (MU=0 IMPOSED IN BERKHO.F)
00468       LF = 0
00469 !
00470 
00471 300   CONTINUE
00472 ! INITIALISES THE WAVE HEIGHT FOR RANDOM SEAS AT 0.
00473 !
00474       IF (ALEMON .OR. ALEMUL) THEN
00475         CALL OS('X=C     ', HALE , SBID , SBID , 0.D0 )
00476         CALL OS('X=C     ', UEB  , SBID , SBID , 0.D0 )
00477         IF (LF.EQ.0) THEN
00478           ITERMUR=0
00479         ENDIF
00480       ENDIF
00481 !
00482 ! INITIALISES QB, T01, T02 AND TM : SET TO 0 AT THE START OF COMPUTATION
00483 !
00484       CALL OS('X=C     ', QB , SBID , SBID , 0.D0 )
00485       CALL OS('X=C     ', T01 , SBID , SBID , 0.D0 )
00486       CALL OS('X=C     ', T02 , SBID , SBID , 0.D0 )
00487       CALL OS('X=C     ', TM , SBID , SBID , 0.D0 )
00488 !
00489 !
00490 ! INITIALISES RADIATION STRESSES AND
00491 ! FORCINGS
00492 !
00493       CALL OS('X=C     ', FX , SBID , SBID , 0.D0 )
00494       CALL OS('X=C     ', FY , SBID , SBID , 0.D0 )
00495       CALL OS('X=C     ', SXX , SBID , SBID , 0.D0 )
00496       CALL OS('X=C     ', SXY , SBID , SBID , 0.D0 )
00497       CALL OS('X=C     ', SYY , SBID , SBID , 0.D0 )
00498       CALL OS('X=C     ', MCOS , SBID , SBID , 0.D0 )
00499       CALL OS('X=C     ', MSIN , SBID , SBID , 0.D0 )
00500 !
00501 !
00502 ! IN MULTIDIRECTIONAL RANDOM SEA, THE DIRECTIONS OF PROPAGATION
00503 ! (AT THE BOUNDARY) HAVE BEEN CALCULATED IN DALE.
00504 !
00505 200   IF (ALEMUL) THEN
00506         CALL OS('X=C     ', TETAB ,SBID,SBID, DALE%R(LDIR) )
00507         CALL ENTART(2,DALE%R(LDIR),LT,LDIR,NDALE,ALEMON,ALEMUL,BALAYE)
00508       ENDIF
00509 !
00510 100   CONTINUE
00511 !
00512 !     PRINT NEW VALUE OF THE PERIOD
00513       IF (BALAYE) THEN
00514         CALL ENTART(1,PER,LT,LPER,NPERBA,ALEMON,ALEMUL,BALAYE)
00515       ELSE
00516         CALL ENTART(1,PER,LT,LPER,NPALE,ALEMON,ALEMUL,BALAYE)
00517       ENDIF
00518 !
00519 !
00520 !=======================================================================
00521 !
00522 ! : 2                  INITIALISES
00523 !
00524 !=======================================================================
00525 !
00526 ! INITIALISES PHYSICAL PARAMETERS
00527 !
00528 !
00529       CALL CONDIH
00530 !
00531 !=======================================================================
00532 !
00533 ! : 3                  BOUNDARY CONDITIONS
00534 !
00535 !=======================================================================
00536 !
00537 ! MASKING FOR THE BOUNDARY CONDITIONS
00538 !
00539 ! CALLS THE USER SUBROUTINE
00540 !
00541       CALL BORH
00542 !     IMPOSE THE OLD TETAP TO THE BOUNDARY EXCEPT FOR THE FIRST COMPUTATION
00543       IF ((LANGAUTO).AND.(LT.GT.0)) THEN
00544         DO I=1,NPTFR
00545           TETAP%R(I)=TETAPM%R(I)
00546         ENDDO
00547       ENDIF
00548 ! ===================================================================================
00549 !
00550 ! : 3 . 1              BOUNDARY CONDITIONS FOR RANDOM SPECTRUM
00551 !                      ---------------------------------------
00552 ! CALCULATES THE BOUNDARY CONDITIONS ON THE POTENTIAL FROM USER INPUT.
00553 ! RANDOM INCIDENT WAVE for freq i : HBi = Hs/sqrt(Ndale*Npale)
00554 ! This way Hs**2 = (HB1**2+HB2**2+...+HBN**2)
00555 ! Thus, HB is a significant wave height such as :
00556 ! HB = sqrt(2) * Hi where Hi=Ai/2 where Ai**2 = 2 Sp(f,teta) df dteta)
00557 ! N.B :
00558 ! If sign. wave height has to be varied depending on f,teta,
00559 ! USE HB(I) = 16D0*(Sp(f,teta)*df*dteta) , or PONDER = 16D0*(Sp(f,teta)*df*dteta)/Hs
00560 ! ==================================================================================
00561       PONDER=1D0/DBLE(NPALE*NDALE)
00562 !      WRITE(6,*) 'HB ponder=',HSCAL*SQRT(PONDER)
00563       IF (ALEMON.OR.ALEMUL) THEN
00564         IF (CHAINTWC) THEN
00565 !         IF SPECTRUM FROM TOMAWAC, Hs TAKEN FROM SPECTRUM INTEGRATION
00566           DO I=1,NPTFR
00567             HB%R(I)=HSCAL*SQRT(PONDER)
00568           ENDDO
00569         ELSE
00570 !         IF SPECTRUM FROM ARTEMIS, HS TAKEN FROM BORH FILE
00571           DO I=1,NPTFR
00572             HB%R(I)=HB%R(I)*SQRT(PONDER)
00573           ENDDO
00574         ENDIF
00575       ENDIF
00576 !
00577 !      IF (LT .EQ. 0) THEN
00578       CALL MASQUE_ARTEMIS
00579 !
00580       CALL PHBOR
00581 !      END IF
00582 !
00583 !=======================================================================
00584 !
00585 ! : 4                  SOLVES THE BERKHOFF EQUATION
00586 !
00587 !=======================================================================
00588 !
00589 !      WRITE(6,*) 'AVANT BERKHO'
00590       CALL BERKHO (LF)
00591 !      WRITE(6,*) 'APRES BERKHO'
00592 !
00593 !
00594 !=======================================================================
00595 !
00596 ! : 5.1        COMPUTES SPEED, FREE SURFACE ELEVATION,
00597 !              WAVE HEIGHT AND PHASE
00598 !
00599 !=======================================================================
00600 !
00601       CALL CALRES
00602 !
00603       IF (ALEMON .OR. ALEMUL) THEN
00604 !
00605 !       CUMULATIVELY COMPUTES THE M1, M2, AND MT1 MOMENTUMS
00606 !       STORED UNTIL THE LAST COMPUTATION IN T01, T02, AND TM
00607         CALL CALCMN
00608 !
00609       ENDIF
00610 !
00611 !
00612 !=======================================================================
00613 !
00614 ! : 5.2        COMPUTES RADIATION STRESSES AND
00615 !              DRIVING FORCES FOR REGULAR WAVES.
00616 !
00617 !=======================================================================
00618 !
00619       IF (.NOT.ALEMON .AND. .NOT.ALEMUL) THEN
00620 !
00621         IF (LISHOU) THEN
00622           CALL DISMOY
00623      &    (NPOIN,NELEM,MESH%X%R,MESH%Y%R,MESH%IKLE%I,K%R,LISHHO)
00624         ELSE
00625           LISHHO = 0
00626         ENDIF
00627 !
00628         CALL RADIA1 (LISHHO)
00629 !
00630       ELSE
00631         LISHHO = 0
00632       ENDIF
00633 !=======================================================================
00634 !
00635 ! : 6   CALLS A USER SUBROUTINE FOR PRINT OUTS, ANALYTICAL SOLUTIONS...
00636 !       (STANDARD SUBROUTINE DOES NOT DO ANYTHING)
00637 !
00638 !=======================================================================
00639 !
00640       CALL UTIMP
00641      &(PHIR%R,PHII%R,C%R,CG%R,K%R,MESH%X%R,MESH%Y%R,ZF%R,H%R,
00642      & HHO%R,U0%R,V0%R,PHAS%R,S%R,T1%R,T2%R,T3%R,T4%R,INCI%R,
00643      & GRAV,PER,OMEGA,MESH%IKLE%I,MESH%NBOR%I,MESH%KP1BOR%I,
00644      & NELEM,NELMAX,IELM,IELMB,NPTFR,NPOIN,PRIVE)
00645 !
00646 !      WRITE(6,*) 'SORTIE  DE  UTIMP'
00647 !=======================================================================
00648 !
00649 ! : 7                  PRINTS OUT THE RESULTS
00650 !
00651 !=======================================================================
00652 !
00653 !
00654 ! FOR RANDOM SEAS,
00655 ! OUTPUTS ONLY AT THE PEAK PERIOD
00656 !
00657       IF (.NOT.ALEMON .AND. .NOT.ALEMUL) THEN
00658 !
00659 !=======================================================================
00660 !
00661 !     CONVERTS INCI INTO DEGREES
00662 !
00663 !=======================================================================
00664 !
00665         CALL OS('X=CX    ', INCI , SBID , SBID , RADDEG )
00666 !
00667 ! RUBENS FILE
00668 !
00669         CALL BIEF_DESIMP(ART_FILES(ARTRES)%FMT,VARSOR,
00670      &            HIST,0,NPOIN,ART_FILES(ARTRES)%LU,'STD',PER,0,
00671      &            LISPRD,LEOPRD,
00672      &            SORLEO,SORIMP,MAXVAR,TEXTE,0,0)
00673 !
00674 !=======================================================================
00675 !
00676 !              COMPARISON AGAINST A REFERENCE FILE
00677 !
00678 !=======================================================================
00679 !
00680 !     THE VALIDA SUBROUTINE FROM THE BIEF LIBRARY IS STANDARD.
00681 !     IT CAN BE MODIFIED BY THE USER FOR THEIR PARTICULAR CASE.
00682 !     BUT THE CALL TO THE SUBROUTINE MUST STAY IN THE TIME LOOP.
00683 !
00684         IF(VALID) THEN
00685           CALL BIEF_VALIDA(TB,TEXTE,
00686      &                      ART_FILES(ARTREF)%LU,ART_FILES(ARTREF)%FMT,
00687      &                      VARSOR,TEXTE,
00688      &                      ART_FILES(ARTRES)%LU,ART_FILES(ARTRES)%FMT,
00689      &                      MAXVAR,NPOIN,LT,LT,ALIRE)
00690         ENDIF
00691 !
00692       ENDIF
00693 !
00694 !=======================================================================
00695 !
00696 ! : 8                  GOES TO NEXT PERIOD
00697 !
00698 !=======================================================================
00699 !
00700 ! IF SWEEPS A RANGE OF PERIODS
00701 !
00702       IF (BALAYE) THEN
00703         LT   = LT  + 1
00704         LPER = LPER + 1
00705         PER  = PER + PERPAS
00706         IF (PER.LE.PERFIN) GOTO 100
00707       ENDIF
00708 !
00709 !
00710 !=======================================================================
00711 !
00712 ! IF RANDOM SEAS
00713 !
00714 !=======================================================================
00715 !
00716       IF (ALEMON .OR. ALEMUL) THEN
00717 !
00718         LT  = LT  + 1
00719 !
00720         IF (LT.LT.NPALE*NDALE) THEN
00721 !
00722           IF (LNG.EQ.1) WRITE(LU,220) ITERMUR+1
00723           IF (LNG.EQ.2) WRITE(LU,221) ITERMUR+1
00724 !
00725 !         REACTUALISES THE ENERGY OF THE RANDOM SEA
00726           CALL OS('X=X+CYZ ',HALE,HHO,HHO,1.D0)
00727 !
00728 !         VELOCITY FOR BOTTOM FRICTION
00729           CALL CALUEB2
00730 !
00731 !
00732 !         GOES TO NEXT PERIOD
00733           LPER = LPER + 1
00734           PER = PALE%R(LPER)
00735           IF (LPER.LE.NPALE) GOTO 100
00736 
00737 !         GOES TO NEXT DIRECTION
00738 !         UPDATE OF PALE IF SPECTRUM FROM TOMAWAC
00739           LDIR = LDIR + 1
00740           IF (CHAINTWC) THEN
00741             DO I=1,NPALE
00742               PALE%R(I)=PDALE%R((LDIR-1)*NPALE+I)
00743             ENDDO
00744           ENDIF
00745           LPER=1
00746           PER = PALE%R(LPER)
00747           IF (LDIR.LE.NDALE) GOTO 200
00748 !
00749         ELSE
00750 !
00751 !         LAST COMPUTATION: DETERMINES THE MEAN PERIODS
00752 !         (T01 AND T02), AND THE MEAN DIRECTION (INCI)
00753 !
00754 !
00755           CALL CALCTM
00756 !
00757 !         DETERMINES MEAN K, C AND CG
00758 !
00759           CALL CALRE2
00760 !
00761 !         TAKES INTO ACCOUNT THE LAST WAVE HEIGHT
00762 !         FOR RANDOM SEAS
00763           CALL OS('X=X+CYZ ',HALE,HHO,HHO,1.D0)
00764           CALL OS('X=SQR(Y)', HALE , HALE , SBID , BID )
00765 !
00766 !         VELOCITY FOR BOTTOM FRICTION
00767           CALL CALUEB2
00768           CALL OS('X=SQR(Y)', UEB , UEB , SBID , BID )
00769 !
00770 !
00771 !=======================================================================
00772 !         LOOP ON THE DISSIPATION COEFFICIENT
00773 !                    FOR IRREGULAR WAVES
00774 !
00775           IF (DEFERL .OR. FROTTE) THEN
00776             CALL CALCMU(ITERMUR)
00777 !           WORK TABLE USED                      : T1,T4
00778 !           WORK TABLE USED AND TO BE CONSERVED  : T3 => QB
00779             CALL RELAXMU(ECRHMU,MODHMU,ITERMUR)
00780 !           ----------------------------------------------------
00781 !           CHECKS CONVERGENCE ON THE DISSIPATION ITERATIVE LOOP
00782 !           ----------------------------------------------------
00783             WRITE(LU,*) ' '
00784             WRITE(LU,*) '--------------------------------------------'
00785             IF (ECRHMU.GT.EPSDIS*MODHMU) THEN
00786               LDIR = 1
00787               LPER = 1
00788               PER  = PALE%R(LPER)
00789 !             FOR USE OF CALCULATED MU IN BERKHO
00790               LF   = 1
00791               LT   = 0
00792               GOTO 300
00793             ENDIF
00794 !
00795             IF (LNG.EQ.1) WRITE(LU,700) ITERMUR
00796             IF (LNG.EQ.2) WRITE(LU,701) ITERMUR
00797 !
00798           ENDIF
00799  700      FORMAT(/,1X,'NB DE SOUS-ITERATIONS POUR LA DISSIPATION:',
00800      &       1X,I3)
00801  701      FORMAT(/,1X,'NUMBER OF SUB-ITERATIONS FOR DISSIPATION:',
00802      &       1X,I3)
00803  220      FORMAT(/,1X,'SOUS-ITERATION NUMERO :',1X,I3,/)
00804  221      FORMAT(/,1X,'SUB-ITERATION NUMBER :',1X,I3,/)
00805 !
00806 !=======================================================================
00807 !
00808 !           COMPUTES RADIATION STRESSES
00809 !           AND DRIVING FORCES FOR RANDOM SEAS
00810 !
00811 !=======================================================================
00812 !
00813           CALL RADIA2 (LISHHO)
00814 !
00815 !=======================================================================
00816 !
00817 !        CONVERTS INCI INTO DEGREES
00818 !
00819 !=======================================================================
00820 !
00821           CALL OS('X=CX    ', INCI , SBID , SBID , RADDEG )
00822 !
00823 !=======================================================================
00824 !
00825 !           RUBENS FILE
00826 !
00827 !=======================================================================
00828 ! CCP ON IMPRIME OMEGAM ET OMEGAP pour BJ 78
00829 !            DO I = 1,NPOIN
00830 !              PRIVE%ADR(1)%P%R(I) = OMEGAM%R(I)
00831 !              PRIVE%ADR(2)%P%R(I) = 2D0*3.1415D0/PERPIC
00832 !              PRIVE%ADR(3)%P%R(I) = T01%R(I)
00833 !              PRIVE%ADR(4)%P%R(I) = PERPIC
00834 !            ENDDO
00835 !
00836           CALL BIEF_DESIMP(ART_FILES(ARTRES)%FMT,VARSOR,
00837      &            HIST,0,NPOIN,ART_FILES(ARTRES)%LU,'STD',PERPIC,0,
00838      &            LISPRD,LEOPRD,
00839      &            SORLEO,SORIMP,MAXVAR,TEXTE,0,0)
00840 !
00841 !=======================================================================
00842 !
00843 !              COMPARISON AGAINST A REFERENCE FILE
00844 !
00845 !=======================================================================
00846 !
00847 !
00848 !     THE VALIDA SUBROUTINE FROM THE BIEF LIBRARY IS STANDARD.
00849 !     IT CAN BE MODIFIED BY THE USER FOR THEIR PARTICULAR CASE.
00850 !     BUT THE CALL TO THE SUBROUTINE MUST STAY IN THE TIME LOOP.
00851 !
00852           IF(VALID) THEN
00853             CALL BIEF_VALIDA(TB,TEXTE,
00854      &                       ART_FILES(ARTREF)%LU,ART_FILES(ARTREF)%FMT,
00855      &                       VARSOR,TEXTE,
00856      &                       ART_FILES(ARTRES)%LU,ART_FILES(ARTRES)%FMT,
00857      &                       MAXVAR,NPOIN,LT,LT,ALIRE)
00858           ENDIF
00859 !
00860         ENDIF
00861 !
00862       ENDIF
00863 !
00864 !-----------------------------------------------------------------------
00865 !
00866       RETURN
00867       END
00868 
00869 
00870 
00871 
00872 
00873 
00874 
00875 
00876 
00877 
00878 
00879 

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