sortie.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE sortie
!                   *****************
!
     &( chaine , mnemo , nbre , sorleo )
!
!***********************************************************************
! BIEF   V7P3                                   29/08/2018
!***********************************************************************
!
!brief    SETS VARIABLES SORLEO AND SORIMP.
!
!history  J-M HERVOUET (LNHE)
!+        03/11/2009
!+        V6P0
!+   JOKER '*' ALLOWED IN NAMES
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  S.E.BOURBAN (HRW)
!+        11/11/2016
!+        V7P2
!+   The * symbol now only represent a number, such as T* for all
!+   tracers (T1, T2, ... T10, T11, etc.) but not for TAU_S and others
!+   Note that G* will not pick up G, but only G1, G2, etc.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CHAINE         |<->| STRING OF VARIABLES FOR GRAPHIC OUTPUTS
!| MNEMO          |<->| MNEMO OF VARIABLES
!| NBRE           |-->| NUMBER OF VARIABLES
!| SORLEO         |<->| LOGICAL ARRAY
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NBRE
!
      CHARACTER(LEN=*), INTENT(INOUT) :: CHAINE
      CHARACTER(LEN=8), INTENT(IN) :: MNEMO(nbre)
!
      LOGICAL, INTENT(INOUT) :: SORLEO(nbre)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
! INTERNAL VARIABLES:
!
      CHARACTER C(2)
      CHARACTER(LEN=8) MOT(100)
      CHARACTER(LEN=10) :: KS
      CHARACTER(LEN=26) :: KL
      INTEGER I,J,LONG,I1,I2,NMOT,L,KI
      LOGICAL OK,FOUND
!
      INTRINSIC len
!
!-----------------------------------------------------------------------
!
      parameter( ks = '0123456789' )
      parameter( kl = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' )
!
!-----------------------------------------------------------------------
!
!  RECOGNISED SEPARATORS IN 'CHAINE'
!
      DO i=1,100
        mot(i) = '        '
      ENDDO
      c(1) = ','
      c(2) = ';'
      long = len(chaine)
      IF (long.EQ.0) THEN
        IF(lng.EQ.1) WRITE(lu,1002)
        IF(lng.EQ.2) WRITE(lu,1003)
1002    FORMAT(1x,'SORTIE (BIEF) : CHAINE VIDE')
1003    FORMAT(1x,'SORTIE (BIEF): EMPTY STRING')
        CALL plante(1)
        stop
      ENDIF
!
      DO i=1,long
        DO j=1,2
          IF(chaine(i:i).EQ.c(j)) chaine(i:i) = ' '
        ENDDO
      ENDDO
!
! 'CHAINE' NOW IS MADE UP OF WORDS SEPARATED BY WHITE SPACES
!
      i1 = 0
      nmot=0
!
 10   CONTINUE
      IF (i1.GE.long) GOTO 30
      i1=i1+1
      IF (chaine(i1:i1).EQ.' ') GOTO 10
!
      i2=0
!
 20   CONTINUE
      i2=i2+1
      IF (chaine(i1+i2:i1+i2).NE.' ') GOTO 20
!
      nmot=nmot+1
      IF (i2.GT.8) THEN
        IF(lng.EQ.1) WRITE(lu,1004) chaine
        IF(lng.EQ.2) WRITE(lu,1005) chaine
1004    FORMAT(1x,'SORTIE (BIEF) : PLUS DE 8 CARACTERES PAR MOT',/,1x,
     &            '                 DANS LA CHAINE :',a)
1005    FORMAT(1x,'SORTIE (BIEF): MORE THAN 8 LETTERS PER WORD',/,1x,
     &            '                 IN THE CHAIN: ',a)
        CALL plante(1)
        stop
      ENDIF
      mot(nmot)=chaine(i1:i1+i2)
      i1=i1+i2
      GOTO 10
!
30    CONTINUE
!
!     COMPARES 'MOT' AND 'MNEMO'
!
      DO i=1,nbre
        DO j=1,nmot
          ok=.true.
          DO l=1,8
            IF( mot(j)(l:l).NE.mnemo(i)(l:l) ) THEN
!           A JOKER '*' IS ALLOWED BUT ONLY TO REPLACE A NUMBER
              IF( mot(j)(l:l).EQ.'*'.AND.mnemo(i)(l:l).NE.' ' ) THEN
                found = .false.
                DO ki = 1,10
                  IF( mnemo(i)(l:l).EQ.ks(ki:ki) ) THEN
!                   CHECK ON THE NEXT CHARACTER TO AVOID
!                   SORLEO.EQ.TRUE FOR ALL VARIABLES STARTING WITH '*'
                    IF(mnemo(i)(l+1:l+1).EQ.mot(j)(l+1:l+1).OR.
     &                 mnemo(i)(l+2:l+2).EQ.mot(j)(l+1:l+1)) THEN
                      found = .true.
                    ENDIF
                  ENDIF
                ENDDO
                IF( found ) EXIT
!           A TILDA '~' IS ALLOWED BUT ONLY TO REPLACE CHARACTERS
              ELSEIF( mot(j)(l:l).EQ.'~'.AND.mnemo(i)(l:l).NE.' ' ) THEN
                found = .false.
                DO ki = 1,26
                  IF( mnemo(i)(l:l).EQ.kl(ki:ki) ) found = .true.
                ENDDO
                IF( found ) EXIT
              ENDIF
              ok=.false.
              EXIT
            ENDIF
            IF( mot(j)(l:l).EQ.' '.AND.mnemo(i)(l:l).EQ.' ') EXIT
          ENDDO
          sorleo(i)=ok
          IF(sorleo(i)) EXIT
        ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END