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	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