1 | SUBROUTINE inilun |
---|
2 | C**** |
---|
3 | C ***************************** |
---|
4 | C * OASIS ROUTINE - LEVEL 0 * |
---|
5 | C * ------------- ------- * |
---|
6 | C ***************************** |
---|
7 | C |
---|
8 | C**** *inilun* - Initialize logical unit numbers |
---|
9 | C |
---|
10 | C Purpose: |
---|
11 | C ------- |
---|
12 | C Creates and prints logical unit numbers used to deal with |
---|
13 | C grids, masks and surfaces files as well as anais-related files |
---|
14 | C |
---|
15 | C** Interface: |
---|
16 | C --------- |
---|
17 | C *CALL* *inilun* |
---|
18 | C |
---|
19 | C Input: |
---|
20 | C ----- |
---|
21 | C None |
---|
22 | C |
---|
23 | C Output: |
---|
24 | C ------ |
---|
25 | C None |
---|
26 | C |
---|
27 | C Workspace: |
---|
28 | C --------- |
---|
29 | C None |
---|
30 | C |
---|
31 | C Externals: |
---|
32 | C --------- |
---|
33 | C None |
---|
34 | C |
---|
35 | C Reference: |
---|
36 | C --------- |
---|
37 | C See OASIS manual (1995) |
---|
38 | C |
---|
39 | C History: |
---|
40 | C ------- |
---|
41 | C Version Programmer Date Description |
---|
42 | C ------- ---------- ---- ----------- |
---|
43 | C 1.0 L. Terray 94/01/01 created |
---|
44 | C 2.0 L. Terray 95/08/23 modified: new structure |
---|
45 | C 2.2 L. Terray 97/10/10 added: unit nudum for SVIPC |
---|
46 | C 2.3 S. Valcke 99/03/30 added: unit nulgn for NINENN |
---|
47 | C 2.3 S. Valcke 99/04/30 added: printing levels |
---|
48 | C |
---|
49 | C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
50 | C |
---|
51 | C* ---------------- Include files and USE of modules--------------------------- |
---|
52 | C |
---|
53 | USE mod_parameter |
---|
54 | USE mod_string |
---|
55 | USE mod_unit |
---|
56 | USE mod_printing |
---|
57 | USE mod_hardware |
---|
58 | C |
---|
59 | C* ---------------------------- Poema verses ---------------------------- |
---|
60 | C |
---|
61 | C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
62 | C |
---|
63 | C* 1. Assign unit numbers and initialize comlun |
---|
64 | C ----------------------------------------- |
---|
65 | C |
---|
66 | C* First we open output file for coupler |
---|
67 | C |
---|
68 | IF (nlogprt .GE. 1) THEN |
---|
69 | WRITE (UNIT = nulou,FMT = *) ' ' |
---|
70 | WRITE (UNIT = nulou,FMT = *) ' ' |
---|
71 | WRITE (UNIT = nulou,FMT = *) |
---|
72 | $ ' ROUTINE inilun - Level 0' |
---|
73 | WRITE (UNIT = nulou,FMT = *) |
---|
74 | $ ' ************** *******' |
---|
75 | WRITE (UNIT = nulou,FMT = *) ' ' |
---|
76 | WRITE (UNIT = nulou,FMT = *) |
---|
77 | $ ' Set up logical unit numbers' |
---|
78 | WRITE (UNIT = nulou,FMT = *) ' ' |
---|
79 | ENDIF |
---|
80 | C |
---|
81 | C* If there is no field going through Oasis then assign only the trace file |
---|
82 | C unit for CLIM |
---|
83 | IF (.not. lg_oasis_field) THEN |
---|
84 | nultr = 7 |
---|
85 | IF (nlogprt .GE. 1) |
---|
86 | $ WRITE (UNIT = nulou,FMT = *)'Trace file unit for CLIM :', |
---|
87 | $ nultr |
---|
88 | ELSE |
---|
89 | C* Grids file |
---|
90 | nulgr = 11 |
---|
91 | C* Masks file |
---|
92 | nulma = 12 |
---|
93 | C* Surfaces file |
---|
94 | nulsu = 13 |
---|
95 | C* File for reduced grid masks |
---|
96 | nulrd = 14 |
---|
97 | C* Trace file for CLIM and PVM |
---|
98 | nultr = 7 |
---|
99 | C* Output file for ANAIS interpolation |
---|
100 | nulan = 8 |
---|
101 | C* Dummy file for SVIPC library |
---|
102 | nudum = 9 |
---|
103 | C* Anaism weights file |
---|
104 | nulcc = 16 |
---|
105 | C* Anaisg weights file |
---|
106 | nulgg = 17 |
---|
107 | C* NINENN weight and address file |
---|
108 | nulgn = 18 |
---|
109 | C |
---|
110 | C |
---|
111 | C* 2. Print comlun |
---|
112 | C ------------ |
---|
113 | C |
---|
114 | IF (nlogprt .GE. 1) THEN |
---|
115 | WRITE (UNIT = nulou,FMT ='( |
---|
116 | $ '' nulin ='',i3,'' nulou ='',i3, |
---|
117 | $ '' nulgr ='',i3,'' nulma ='',i3, |
---|
118 | $ '' nulsu ='',i3,'' nultr ='',i3, |
---|
119 | $ '' nulcc ='',i3,'' nulgg ='',i3,'' nulgn ='',i3, |
---|
120 | $ '' nulan ='',i3,'' nulrd ='',i3,'' nudum ='',i3,/)') |
---|
121 | $ nulin, nulou, nulgr, nulma, nulsu, |
---|
122 | $ nultr, nulcc, nulgg, nulgn, nulan, nulrd, nudum |
---|
123 | ENDIF |
---|
124 | C |
---|
125 | C |
---|
126 | C |
---|
127 | C* 3. Assign unit numbers to input and output binary files |
---|
128 | C ---------------------------------------------------- |
---|
129 | C |
---|
130 | nluinp(1)=21 |
---|
131 | DO 310 jf = 2, ig_nfield |
---|
132 | isamefic=0 |
---|
133 | DO 320 jj = 1, jf-1 |
---|
134 | IF (cficinp(jf) .eq. cficinp(jj)) THEN |
---|
135 | isamefic=1 |
---|
136 | nluinp(jf) = nluinp(jj) |
---|
137 | ENDIF |
---|
138 | 320 CONTINUE |
---|
139 | IF (isamefic .lt. 1) nluinp(jf) = 20 + jf |
---|
140 | 310 CONTINUE |
---|
141 | C |
---|
142 | C* For PIPE technique only |
---|
143 | C |
---|
144 | IF (cchan. eq. 'PIPE' .or. cchan. eq. 'NONE') THEN |
---|
145 | nluout(1)=21 + ig_nfield |
---|
146 | DO 330 jf = 2, ig_nfield |
---|
147 | DO 340 jj = 1, jf-1 |
---|
148 | IF(cficout(jf) .eq. cficout(jj)) THEN |
---|
149 | nluout(jf) = nluout(jj) |
---|
150 | ELSE |
---|
151 | nluout(jf) = 20 + ig_nfield + jf |
---|
152 | ENDIF |
---|
153 | 340 CONTINUE |
---|
154 | 330 CONTINUE |
---|
155 | ENDIF |
---|
156 | ENDIF |
---|
157 | C |
---|
158 | C* 4. End of routine |
---|
159 | C -------------- |
---|
160 | C |
---|
161 | IF (nlogprt .GE. 1) THEN |
---|
162 | WRITE (UNIT = nulou,FMT = *) ' ' |
---|
163 | WRITE (UNIT = nulou,FMT = *) |
---|
164 | $ ' --------- End of routine inilun ---------' |
---|
165 | CALL FLUSH (nulou) |
---|
166 | ENDIF |
---|
167 | RETURN |
---|
168 | END |
---|
169 | |
---|
170 | |
---|
171 | |
---|
172 | |
---|
173 | |
---|
174 | |
---|