IOIPSL/Mathelp/buildop.f

module buildop_m

  implicit none

contains

  SUBROUTINE buildop (str, ex_topps, topp, nbops_max, &
       &                  missing_val, opps, scal, nbops)
    !- This subroutine decomposes the input string in the elementary
    !- functions which need to be applied to the vector of data.
    !- This vector is represented by X in the string.
    !- This subroutine is the driver of the decomposition and gets
    !- the time operation but then call decoop for the other operations
    !- INPUT

    !- str      : String containing the operations
    !- ex_toops : The time operations that can be expected
    !-            within the string

    !- OUTPUT

    USE errioipsl, ONLY : histerr
    use decoop_m, only: decoop

    CHARACTER(LEN=80) :: str
    CHARACTER(LEN=*) :: ex_topps
    CHARACTER(LEN=7) :: topp
    INTEGER :: nbops_max, nbops
    CHARACTER(LEN=7) :: opps(nbops_max)
    REAL :: scal(nbops_max), missing_val

    CHARACTER(LEN=80) :: new_str
    INTEGER :: leng, ind_opb, ind_clb

    LOGICAL :: check = .FALSE.
    !---------------------------------------------------------------------
    IF (check) WRITE(*, *) 'buildop : Some preliminary cleaning'

    leng = LEN_TRIM(str)
    IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
       str = str(2:leng-1)
       leng = leng-2
    ENDIF

    IF (check) &
         &  WRITE(*, *) 'buildop : Starting to test the various options'

    IF (leng <= 5 .AND. INDEX(ex_topps, str(1:leng)) > 0) THEN
       IF (check) WRITE(*, *) 'buildop : Time operation only'
       nbops = 0
       topp = str(1:leng)
    ELSE
       IF (check) THEN
          WRITE(*, *) 'buildop : Time operation and something else'
       ENDIF
       !--
       ind_opb = INDEX(str(1:leng), '(')
       IF (ind_opb > 0) THEN
          IF (INDEX(ex_topps, str(1:ind_opb-1)) > 0) THEN
             IF (check) THEN
                WRITE(*, '(2a)') &
                     &          ' buildop : Extract time operation from : ', str
             ENDIF
             topp = str(1:ind_opb-1)
             ind_clb = INDEX(str(1:leng), ')', BACK=.TRUE.)
             new_str = str(ind_opb+1:ind_clb-1)
             IF (check) THEN
                WRITE(*, '(2a, 2I3)') &
                     &          ' buildop : Call decoop ', new_str, ind_opb, ind_clb
             ENDIF
             CALL decoop (new_str, nbops_max, missing_val, opps, scal, nbops)
          ELSE
             CALL histerr(3, 'buildop', &
                  &        'time opperation does not exist', str(1:ind_opb-1), ' ')
          ENDIF
       ELSE
          CALL histerr(3, 'buildop', &
               &      'some long opperation exists but wihout parenthesis', &
               &      str(1:leng), ' ')
       ENDIF
    ENDIF

    IF (check) THEN
       DO leng=1, nbops
          WRITE(*, *) &
               &      'buildop : i -- opps, scal : ', leng, opps(leng), scal(leng)
       ENDDO
    ENDIF
    !---------------------
  END SUBROUTINE buildop

end module buildop_m
1	guez	104	module buildop_m
2
3			implicit none
4
5			contains
6
7			SUBROUTINE buildop (str, ex_topps, topp, nbops_max, &
8			& missing_val, opps, scal, nbops)
9			!- This subroutine decomposes the input string in the elementary
10			!- functions which need to be applied to the vector of data.
11			!- This vector is represented by X in the string.
12			!- This subroutine is the driver of the decomposition and gets
13			!- the time operation but then call decoop for the other operations
14			!- INPUT
15
16			!- str : String containing the operations
17			!- ex_toops : The time operations that can be expected
18			!- within the string
19
20			!- OUTPUT
21
22			USE errioipsl, ONLY : histerr
23			use decoop_m, only: decoop
24
25			CHARACTER(LEN=80) :: str
26			CHARACTER(LEN=*) :: ex_topps
27			CHARACTER(LEN=7) :: topp
28			INTEGER :: nbops_max, nbops
29			CHARACTER(LEN=7) :: opps(nbops_max)
30			REAL :: scal(nbops_max), missing_val
31
32			CHARACTER(LEN=80) :: new_str
33			INTEGER :: leng, ind_opb, ind_clb
34
35			LOGICAL :: check = .FALSE.
36			!---------------------------------------------------------------------
37			IF (check) WRITE(, ) 'buildop : Some preliminary cleaning'
38
39			leng = LEN_TRIM(str)
40			IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
41			str = str(2:leng-1)
42			leng = leng-2
43			ENDIF
44
45			IF (check) &
46			& WRITE(, ) 'buildop : Starting to test the various options'
47
48			IF (leng <= 5 .AND. INDEX(ex_topps, str(1:leng)) > 0) THEN
49			IF (check) WRITE(, ) 'buildop : Time operation only'
50			nbops = 0
51			topp = str(1:leng)
52			ELSE
53			IF (check) THEN
54			WRITE(, ) 'buildop : Time operation and something else'
55			ENDIF
56			!--
57			ind_opb = INDEX(str(1:leng), '(')
58			IF (ind_opb > 0) THEN
59			IF (INDEX(ex_topps, str(1:ind_opb-1)) > 0) THEN
60			IF (check) THEN
61			WRITE(*, '(2a)') &
62			& ' buildop : Extract time operation from : ', str
63			ENDIF
64			topp = str(1:ind_opb-1)
65			ind_clb = INDEX(str(1:leng), ')', BACK=.TRUE.)
66			new_str = str(ind_opb+1:ind_clb-1)
67			IF (check) THEN
68			WRITE(*, '(2a, 2I3)') &
69			& ' buildop : Call decoop ', new_str, ind_opb, ind_clb
70			ENDIF
71			CALL decoop (new_str, nbops_max, missing_val, opps, scal, nbops)
72			ELSE
73			CALL histerr(3, 'buildop', &
74			& 'time opperation does not exist', str(1:ind_opb-1), ' ')
75			ENDIF
76			ELSE
77			CALL histerr(3, 'buildop', &
78			& 'some long opperation exists but wihout parenthesis', &
79			& str(1:leng), ' ')
80			ENDIF
81			ENDIF
82
83			IF (check) THEN
84			DO leng=1, nbops
85			WRITE(, ) &
86			& 'buildop : i -- opps, scal : ', leng, opps(leng), scal(leng)
87			ENDDO
88			ENDIF
89			!---------------------
90			END SUBROUTINE buildop
91
92			end module buildop_m