Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / readxisolevp.f90
1 !     ######spl
2       MODULE  MODI_READXISOLEVP
3 !     #########################
4 !
5 INTERFACE
6 !
7 SUBROUTINE READXISOLEVP(HCARIN,K,PISOLEVP)
8 INTEGER          :: K
9 CHARACTER(LEN=*) :: HCARIN
10 REAL,DIMENSION(:):: PISOLEVP
11 END SUBROUTINE READXISOLEVP
12 !
13 END INTERFACE
14 !
15 END MODULE MODI_READXISOLEVP
16 !     ######spl
17       SUBROUTINE READXISOLEVP(HCARIN,K,PISOLEVP)
18 !     ##########################################
19 !
20 !!****  *READXISOLEVP* - 
21 !!
22 !!    PURPOSE
23 !!    -------
24 !      
25 !
26 !!**  METHOD
27 !!    ------
28 !!     
29 !!     N.A.
30 !!
31 !!    EXTERNAL
32 !!    --------
33 !!      None
34 !!
35 !!    IMPLICIT ARGUMENTS
36 !!    ------------------
37 !!      Module
38 !!
39 !!      Module
40 !!
41 !!    REFERENCE
42 !!    ---------
43 !!
44 !!
45 !!    AUTHOR
46 !!    ------
47 !!      J. Duron    * Laboratoire d'Aerologie *
48 !!
49 !!
50 !!    MODIFICATIONS
51 !!    -------------
52 !!      Original       2/09/96
53 !!      Updated   PM   
54 !-------------------------------------------------------------------------------
55 !
56 !*       0.    DECLARATIONS
57 !              ------------
58 !
59 USE MODD_RESOLVCAR
60
61 IMPLICIT NONE
62 !
63 !*       0.1   Dummy arguments
64 !              ---------------
65
66 INTEGER           :: K
67 CHARACTER(LEN=*)  :: HCARIN
68 REAL,DIMENSION(:) :: PISOLEVP
69 !
70 !*       0.1   Local variables
71 !              ---------------
72
73 INTEGER           :: IMASK
74 INTEGER           :: J,JM
75 CHARACTER(LEN=LEN(HCARIN)) :: YCARIN, YCARIN2
76
77 !
78 !------------------------------------------------------------------------------
79 YCARIN(1:LEN(YCARIN))=' '
80 HCARIN=ADJUSTL(HCARIN)
81 YCARIN=HCARIN
82 IMASK=INDEX(YCARIN,'MASK')
83 IF(IMASK /=0)THEN
84 DO J=1,LEN(YCARIN)
85  IF(YCARIN(J:J) == ' ')THEN
86    JM=J-1
87    EXIT
88  ENDIF
89 ENDDO
90 YCARIN(1:LEN(YCARIN))=' '
91 YCARIN=HCARIN(JM+2:LEN_TRIM(HCARIN))
92 YCARIN=ADJUSTL(YCARIN)
93 ENDIF
94 JM=0
95 DO J=1,LEN(YCARIN)
96  IF(YCARIN(J:J) == ' ')THEN
97    JM=J-1
98    EXIT
99  ENDIF
100 ENDDO
101 IF(JM /= 0)THEN
102   YCARIN2(1:LEN(YCARIN2))=' '
103   YCARIN2=YCARIN(1:JM)
104   YCARIN(1:LEN(YCARIN))=' '
105   YCARIN=ADJUSTL(YCARIN2)
106 ENDIF
107 !
108 LISOLEVP=.FALSE.
109 IF(NBISOLEVP == 0)THEN
110   LISOLEVP=.FALSE.
111   print *,' AUCUNE VALEUR USER ENREGISTREE POUR : ',YCARIN(1:LEN_TRIM(YCARIN))&
112   ,' sous la forme XISOLEV_PROC= '
113 ELSE
114   DO J=1,NBISOLEVP
115     IF(YCARIN(1:LEN_TRIM(YCARIN)) == CISOLEVP(J)(1:LEN_TRIM(CISOLEVP(J))))THEN
116       K=NLENP(J)
117       PISOLEVP(1:NLENP(J))=XISOLEVP(1:NLENP(J),J)
118       LISOLEVP=.TRUE.
119       IF(NVERBIA >= 5)THEN
120         print *,' READXISOLEVP NLENP PISOLEVP ',K,PISOLEVP(1:NLENP(J))
121       ENDIF
122       EXIT
123     ENDIF
124   ENDDO
125   IF(.NOT.LISOLEVP)THEN
126     print *,' AUCUNE VALEUR USER ENREGISTREE POUR : ',YCARIN(1:LEN_TRIM(YCARIN))&
127     ,' sous la forme XISOLEV_PROC= '
128   ELSE
129      print *,' UTILISATION DES VALEURS ENREGISTREES sous la forme XISOLEV_PROC= '
130      print *,' POUR : ',YCARIN(1:LEN_TRIM(YCARIN))
131      print *,PISOLEVP(1:K-1)
132   ENDIF
133 ENDIF
134 !
135 IF(.NOT.LISOLEVP)THEN
136   print *,' UTILISATION DES VALEURS DE XISOLEV= (si elles existent) POUR : ',YCARIN(1:LEN_TRIM(YCARIN))
137   DO J=1,SIZE(XISOLEV,1)
138     IF(XISOLEV(J) == 9999.)THEN
139       print *,XISOLEV(1:J-1)
140       EXIT
141     ENDIF
142   ENDDO
143 ENDIF
144 RETURN
145 END SUBROUTINE READXISOLEVP