source: trunk/WRF.COMMON/WRFV2/share/module_optional_si_input.F @ 3547

Last change on this file since 3547 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 36.9 KB
Line 
1MODULE module_optional_si_input
2
3   INTEGER :: flag_metgrid  , flag_tavgsfc  , flag_psfc     , flag_soilhgt
4
5   INTEGER :: flag_qv       , flag_qc       , flag_qr       , flag_qi       , flag_qs       , flag_qg
6
7   INTEGER :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
8              flag_sm000010 , flag_sm010040 , flag_sm040100 , flag_sm100200 , flag_sm010200 , &
9              flag_sw000010 , flag_sw010040 , flag_sw040100 , flag_sw100200 , flag_sw010200
10
11   INTEGER :: flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
12              flag_sm000007 , flag_sm007028 , flag_sm028100 , flag_sm100255
13
14   INTEGER :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
15              flag_soilm000 , flag_soilm005 , flag_soilm020 , flag_soilm040 , flag_soilm160 , flag_soilm300 , &
16              flag_soilw000 , flag_soilw005 , flag_soilw020 , flag_soilw040 , flag_soilw160 , flag_soilw300
17
18   INTEGER :: flag_sst      , flag_toposoil , flag_snowh
19
20   INTEGER                  :: num_st_levels_input , num_sm_levels_input , num_sw_levels_input
21   INTEGER                  :: num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc
22   INTEGER , DIMENSION(100) ::     st_levels_input ,     sm_levels_input ,     sw_levels_input
23   REAL , ALLOCATABLE , DIMENSION(:,:,:) :: st_input , sm_input , sw_input
24
25   CHARACTER (LEN=8) , PRIVATE :: flag_name
26 
27   LOGICAL :: already_been_here
28
29CONTAINS
30
31!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32
33   SUBROUTINE init_module_optional_si_input ( grid , config_flags )
34
35      USE module_domain
36      USE module_configure
37
38      IMPLICIT NONE
39
40      TYPE ( domain ) :: grid
41      TYPE (grid_config_rec_type) :: config_flags
42
43      INTEGER :: ids, ide, jds, jde, kds, kde, &
44                 ims, ime, jms, jme, kms, kme, &
45                 its, ite, jts, jte, kts, kte
46
47      !  Get the various indices, assume XZY ordering.
48
49      ids = grid%sd31 ; ide = grid%ed31 ;
50      kds = grid%sd32 ; kde = grid%ed32 ;
51      jds = grid%sd33 ; jde = grid%ed33 ;
52
53      ims = grid%sm31 ; ime = grid%em31 ;
54      kms = grid%sm32 ; kme = grid%em32 ;
55      jms = grid%sm33 ; jme = grid%em33 ;
56
57      its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
58      kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
59      jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
60
61      IF ( .NOT. already_been_here ) THEN
62
63         num_st_levels_alloc = config_flags%num_soil_layers * 3 ! used to be 2
64         num_sm_levels_alloc = config_flags%num_soil_layers * 3
65         num_sw_levels_alloc = config_flags%num_soil_layers * 3
66
67         IF ( ALLOCATED ( st_input ) ) DEALLOCATE ( st_input )
68         IF ( ALLOCATED ( sm_input ) ) DEALLOCATE ( sm_input )
69         IF ( ALLOCATED ( sw_input ) ) DEALLOCATE ( sw_input )
70   
71         ALLOCATE ( st_input(ims:ime,num_st_levels_alloc,jms:jme) )
72         ALLOCATE ( sm_input(ims:ime,num_sm_levels_alloc,jms:jme) )
73         ALLOCATE ( sw_input(ims:ime,num_sw_levels_alloc,jms:jme) )
74
75      END IF
76
77      already_been_here = .TRUE.
78
79   END SUBROUTINE init_module_optional_si_input
80
81!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
82
83   SUBROUTINE optional_si_input ( grid , fid )
84
85      USE module_configure     
86      USE module_domain
87
88      IMPLICIT NONE
89
90      TYPE ( domain ) :: grid
91      INTEGER , INTENT(IN) :: fid
92
93      INTEGER :: ids, ide, jds, jde, kds, kde, &
94                 ims, ime, jms, jme, kms, kme, &
95                 its, ite, jts, jte, kts, kte
96
97      !  Get the various indices, assume XZY ordering.
98
99      ids = grid%sd31 ; ide = grid%ed31 ;
100      kds = grid%sd32 ; kde = grid%ed32 ;
101      jds = grid%sd33 ; jde = grid%ed33 ;
102
103      ims = grid%sm31 ; ime = grid%em31 ;
104      kms = grid%sm32 ; kme = grid%em32 ;
105      jms = grid%sm33 ; jme = grid%em33 ;
106
107      its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
108      kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
109      jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
110
111
112      CALL optional_tavgsfc    ( grid , fid , &
113                                 ids, ide, jds, jde, kds, kde, &
114                                 ims, ime, jms, jme, kms, kme, &
115                                 its, ite, jts, jte, kts, kte  )
116
117      CALL optional_moist      ( grid , fid , &
118                                 ids, ide, jds, jde, kds, kde, &
119                                 ims, ime, jms, jme, kms, kme, &
120                                 its, ite, jts, jte, kts, kte  )
121
122      CALL optional_metgrid    ( grid , fid , &
123                                 ids, ide, jds, jde, kds, kde, &
124                                 ims, ime, jms, jme, kms, kme, &
125                                 its, ite, jts, jte, kts, kte  )
126
127      CALL optional_sst        ( grid , fid , &
128                                 ids, ide, jds, jde, kds, kde, &
129                                 ims, ime, jms, jme, kms, kme, &
130                                 its, ite, jts, jte, kts, kte  )
131
132      CALL optional_snowh      ( grid , fid , &
133                                 ids, ide, jds, jde, kds, kde, &
134                                 ims, ime, jms, jme, kms, kme, &
135                                 its, ite, jts, jte, kts, kte  )
136
137      IF (  ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .OR. &
138            ( model_config_rec%sf_surface_physics(grid%id) .EQ. 2 ) .OR. &
139            ( model_config_rec%sf_surface_physics(grid%id) .EQ. 3 ) .OR. &
140            ( model_config_rec%sf_surface_physics(grid%id) .EQ. 99 ) ) THEN
141
142         CALL optional_lsm        ( grid , fid , &
143                                    ids, ide, jds, jde, kds, kde, &
144                                    ims, ime, jms, jme, kms, kme, &
145                                    its, ite, jts, jte, kts, kte  )
146   
147         CALL optional_lsm_levels ( grid , fid , &
148                                    ids, ide, jds, jde, kds, kde, &
149                                    ims, ime, jms, jme, kms, kme, &
150                                    its, ite, jts, jte, kts, kte  )
151      END IF
152     
153   END SUBROUTINE optional_si_input
154
155!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
156
157   SUBROUTINE optional_moist ( grid , fid , &
158                               ids, ide, jds, jde, kds, kde, &
159                               ims, ime, jms, jme, kms, kme, &
160                               its, ite, jts, jte, kts, kte  )
161
162      USE module_io_wrf
163      USE module_domain
164
165USE module_configure
166USE module_io_domain
167
168      IMPLICIT NONE
169
170      TYPE ( domain ) :: grid
171      INTEGER , INTENT(IN) :: fid
172
173      INTEGER :: ids, ide, jds, jde, kds, kde, &
174                 ims, ime, jms, jme, kms, kme, &
175                 its, ite, jts, jte, kts, kte
176
177      INTEGER :: itmp , icnt , ierr
178
179      flag_qv       = 0
180      flag_qc       = 0
181      flag_qr       = 0
182      flag_qi       = 0
183      flag_qs       = 0
184      flag_qg       = 0
185
186      flag_name(1:8) = 'QV      '
187      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
188      IF ( ierr .EQ. 0 ) THEN
189         flag_qv       = itmp
190      END IF
191      flag_name(1:8) = 'QC      '
192      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
193      IF ( ierr .EQ. 0 ) THEN
194         flag_qc       = itmp
195      END IF
196      flag_name(1:8) = 'QR      '
197      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
198      IF ( ierr .EQ. 0 ) THEN
199         flag_qr       = itmp
200      END IF
201      flag_name(1:8) = 'QI      '
202      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
203      IF ( ierr .EQ. 0 ) THEN
204         flag_qi       = itmp
205      END IF
206      flag_name(1:8) = 'QS      '
207      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
208      IF ( ierr .EQ. 0 ) THEN
209         flag_qs       = itmp
210      END IF
211      flag_name(1:8) = 'QG      '
212      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
213      IF ( ierr .EQ. 0 ) THEN
214         flag_qg       = itmp
215      END IF
216   
217   END SUBROUTINE optional_moist
218
219!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
220
221   SUBROUTINE optional_metgrid ( grid , fid , &
222                                 ids, ide, jds, jde, kds, kde, &
223                                 ims, ime, jms, jme, kms, kme, &
224                                 its, ite, jts, jte, kts, kte  )
225
226      USE module_io_wrf
227      USE module_domain
228USE module_configure
229USE module_io_domain
230
231      IMPLICIT NONE
232
233      TYPE ( domain ) :: grid
234      INTEGER , INTENT(IN) :: fid
235
236      INTEGER :: ids, ide, jds, jde, kds, kde, &
237                 ims, ime, jms, jme, kms, kme, &
238                 its, ite, jts, jte, kts, kte
239
240      INTEGER :: itmp , icnt , ierr
241
242      flag_metgrid = 0
243
244      flag_name(1:8) = 'METGRID '
245      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
246      IF ( ierr .EQ. 0 ) THEN
247         flag_metgrid  = itmp
248      END IF
249   
250   END SUBROUTINE optional_metgrid
251
252!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
253
254   SUBROUTINE optional_sst ( grid , fid , &
255                             ids, ide, jds, jde, kds, kde, &
256                             ims, ime, jms, jme, kms, kme, &
257                             its, ite, jts, jte, kts, kte  )
258
259      USE module_io_wrf
260      USE module_domain
261USE module_configure
262USE module_io_domain
263
264      IMPLICIT NONE
265
266      TYPE ( domain ) :: grid
267      INTEGER , INTENT(IN) :: fid
268
269      INTEGER :: ids, ide, jds, jde, kds, kde, &
270                 ims, ime, jms, jme, kms, kme, &
271                 its, ite, jts, jte, kts, kte
272
273      INTEGER :: itmp , icnt , ierr
274
275      flag_sst      = 0
276
277      flag_name(1:8) = 'SST     '
278      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
279      IF ( ierr .EQ. 0 ) THEN
280         flag_sst      = itmp
281      END IF
282   
283   END SUBROUTINE optional_sst
284
285
286!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
287
288   SUBROUTINE optional_tavgsfc ( grid , fid , &
289                                 ids, ide, jds, jde, kds, kde, &
290                                 ims, ime, jms, jme, kms, kme, &
291                                 its, ite, jts, jte, kts, kte  )
292
293      USE module_io_wrf
294      USE module_domain
295USE module_configure
296USE module_io_domain
297
298      IMPLICIT NONE
299
300      TYPE ( domain ) :: grid
301      INTEGER , INTENT(IN) :: fid
302
303      INTEGER :: ids, ide, jds, jde, kds, kde, &
304                 ims, ime, jms, jme, kms, kme, &
305                 its, ite, jts, jte, kts, kte
306
307      INTEGER :: itmp , icnt , ierr
308
309      flag_tavgsfc  = 0
310
311      flag_name(1:8) = 'TAVGSFC '
312      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
313      IF ( ierr .EQ. 0 ) THEN
314         flag_tavgsfc  = itmp
315      END IF
316   
317   END SUBROUTINE optional_tavgsfc
318
319!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
320
321   SUBROUTINE optional_snowh ( grid , fid , &
322                               ids, ide, jds, jde, kds, kde, &
323                               ims, ime, jms, jme, kms, kme, &
324                               its, ite, jts, jte, kts, kte  )
325
326      USE module_io_wrf
327      USE module_domain
328USE module_configure
329USE module_io_domain
330
331      IMPLICIT NONE
332
333      TYPE ( domain ) :: grid
334      INTEGER , INTENT(IN) :: fid
335
336      INTEGER :: ids, ide, jds, jde, kds, kde, &
337                 ims, ime, jms, jme, kms, kme, &
338                 its, ite, jts, jte, kts, kte
339
340      INTEGER :: itmp , icnt , ierr
341
342      flag_snowh    = 0
343
344      flag_name(1:8) = 'SNOWH   '
345      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
346      IF ( ierr .EQ. 0 ) THEN
347         flag_snowh    = itmp
348      END IF
349   
350   END SUBROUTINE optional_snowh
351
352!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
353
354   SUBROUTINE optional_lsm ( grid , fid , &
355                             ids, ide, jds, jde, kds, kde, &
356                             ims, ime, jms, jme, kms, kme, &
357                             its, ite, jts, jte, kts, kte  )
358
359      USE module_io_wrf
360      USE module_domain
361USE module_configure
362USE module_io_domain
363
364      IMPLICIT NONE
365
366      TYPE ( domain ) :: grid
367      INTEGER , INTENT(IN) :: fid
368
369      INTEGER :: ids, ide, jds, jde, kds, kde, &
370                 ims, ime, jms, jme, kms, kme, &
371                 its, ite, jts, jte, kts, kte
372
373      INTEGER :: itmp , icnt , ierr
374
375      flag_psfc     = 0
376      flag_soilhgt  = 0
377      flag_toposoil = 0
378
379      flag_name(1:8) = 'TOPOSOIL'
380      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
381      IF ( ierr .EQ. 0 ) THEN
382         flag_toposoil = itmp
383      END IF
384
385      flag_name(1:8) = 'PSFC    '
386      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
387      IF ( ierr .EQ. 0 ) THEN
388         flag_psfc     = itmp
389      END IF
390
391      flag_name(1:8) = 'SOILHGT '
392      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
393      IF ( ierr .EQ. 0 ) THEN
394         flag_soilhgt  = itmp
395      END IF
396   
397   END SUBROUTINE optional_lsm
398
399!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
400
401   SUBROUTINE optional_lsm_levels ( grid , fid , &
402                                    ids, ide, jds, jde, kds, kde, &
403                                    ims, ime, jms, jme, kms, kme, &
404                                    its, ite, jts, jte, kts, kte  )
405
406      USE module_io_wrf
407      USE module_domain
408USE module_configure
409USE module_io_domain
410
411      IMPLICIT NONE
412
413      TYPE ( domain ) :: grid
414      INTEGER , INTENT(IN) :: fid
415
416      INTEGER :: ids, ide, jds, jde, kds, kde, &
417                 ims, ime, jms, jme, kms, kme, &
418                 its, ite, jts, jte, kts, kte
419
420      INTEGER :: itmp , icnt , ierr , i , j
421   
422      !  Initialize the soil temp and moisture flags to "field not found".
423
424      flag_st000010 = 0
425      flag_st010040 = 0
426      flag_st040100 = 0
427      flag_st100200 = 0
428      flag_st010200 = 0
429
430      flag_sm000010 = 0
431      flag_sm010040 = 0
432      flag_sm040100 = 0
433      flag_sm100200 = 0
434      flag_sm010200 = 0
435
436      flag_sw000010 = 0
437      flag_sw010040 = 0
438      flag_sw040100 = 0
439      flag_sw100200 = 0
440      flag_sw010200 = 0
441
442      flag_st000007 = 0
443      flag_st007028 = 0
444      flag_st028100 = 0
445      flag_st100255 = 0
446
447      flag_sm000007 = 0
448      flag_sm007028 = 0
449      flag_sm028100 = 0
450      flag_sm100255 = 0
451
452      flag_soilt000 = 0
453      flag_soilt005 = 0
454      flag_soilt020 = 0
455      flag_soilt040 = 0
456      flag_soilt160 = 0
457      flag_soilt300 = 0
458
459      flag_soilm000 = 0
460      flag_soilm005 = 0
461      flag_soilm020 = 0
462      flag_soilm040 = 0
463      flag_soilm160 = 0
464      flag_soilm300 = 0
465
466      flag_soilw000 = 0
467      flag_soilw005 = 0
468      flag_soilw020 = 0
469      flag_soilw040 = 0
470      flag_soilw160 = 0
471      flag_soilw300 = 0
472
473      !  How many soil levels have we found?  Well, right now, none.
474
475      num_st_levels_input = 0
476      num_sm_levels_input = 0
477      num_sw_levels_input = 0
478      st_levels_input = -1
479      sm_levels_input = -1
480      sw_levels_input = -1
481
482      flag_name(1:8) = 'ST000010'
483      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
484      IF ( ierr .EQ. 0 ) THEN
485         flag_st000010 = itmp
486         num_st_levels_input = num_st_levels_input + 1
487         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
488         DO j = jts , MIN(jde-1,jte)
489            DO i = its , MIN(ide-1,ite)
490               st_input(i,num_st_levels_input + 1,j) = grid%st000010(i,j)
491            END DO
492         END DO
493      END IF
494      flag_name(1:8) = 'ST010040'
495      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
496      IF ( ierr .EQ. 0 ) THEN
497         flag_st010040 = itmp
498         num_st_levels_input = num_st_levels_input + 1
499         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
500         DO j = jts , MIN(jde-1,jte)
501            DO i = its , MIN(ide-1,ite)
502               st_input(i,num_st_levels_input + 1,j) = grid%st010040(i,j)
503            END DO
504         END DO
505      END IF
506      flag_name(1:8) = 'ST040100'
507      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
508      IF ( ierr .EQ. 0 ) THEN
509         flag_st040100 = itmp
510         num_st_levels_input = num_st_levels_input + 1
511         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
512         DO j = jts , MIN(jde-1,jte)
513            DO i = its , MIN(ide-1,ite)
514               st_input(i,num_st_levels_input + 1,j) = grid%st040100(i,j)
515            END DO
516         END DO
517      END IF
518      flag_name(1:8) = 'ST100200'
519      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
520      IF ( ierr .EQ. 0 ) THEN
521         flag_st100200 = itmp
522         num_st_levels_input = num_st_levels_input + 1
523         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
524         DO j = jts , MIN(jde-1,jte)
525            DO i = its , MIN(ide-1,ite)
526               st_input(i,num_st_levels_input + 1,j) = grid%st100200(i,j)
527            END DO
528         END DO
529      END IF
530      flag_name(1:8) = 'ST010200'
531      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
532      IF ( ierr .EQ. 0 ) THEN
533         flag_st010200 = itmp
534         num_st_levels_input = num_st_levels_input + 1
535         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
536         DO j = jts , MIN(jde-1,jte)
537            DO i = its , MIN(ide-1,ite)
538               st_input(i,num_st_levels_input + 1,j) = grid%st010200(i,j)
539            END DO
540         END DO
541      END IF
542      flag_name(1:8) = 'SM000010'
543      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
544      IF ( ierr .EQ. 0 ) THEN
545         flag_sm000010 = itmp
546         num_sm_levels_input = num_sm_levels_input + 1
547         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
548         DO j = jts , MIN(jde-1,jte)
549            DO i = its , MIN(ide-1,ite)
550               sm_input(i,num_sm_levels_input + 1,j) = grid%sm000010(i,j)
551            END DO
552         END DO
553      END IF
554      flag_name(1:8) = 'SM010040'
555      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
556      IF ( ierr .EQ. 0 ) THEN
557         flag_sm010040 = itmp
558         num_sm_levels_input = num_sm_levels_input + 1
559         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
560         DO j = jts , MIN(jde-1,jte)
561            DO i = its , MIN(ide-1,ite)
562               sm_input(i,num_sm_levels_input + 1,j) = grid%sm010040(i,j)
563            END DO
564         END DO
565      END IF
566      flag_name(1:8) = 'SM040100'
567      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
568      IF ( ierr .EQ. 0 ) THEN
569         flag_sm040100 = itmp
570         num_sm_levels_input = num_sm_levels_input + 1
571         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
572         DO j = jts , MIN(jde-1,jte)
573            DO i = its , MIN(ide-1,ite)
574               sm_input(i,num_sm_levels_input + 1,j) = grid%sm040100(i,j)
575            END DO
576         END DO
577      END IF
578      flag_name(1:8) = 'SM100200'
579      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
580      IF ( ierr .EQ. 0 ) THEN
581         flag_sm100200 = itmp
582         num_sm_levels_input = num_sm_levels_input + 1
583         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
584         DO j = jts , MIN(jde-1,jte)
585            DO i = its , MIN(ide-1,ite)
586               sm_input(i,num_sm_levels_input + 1,j) = grid%sm100200(i,j)
587            END DO
588         END DO
589      END IF
590      flag_name(1:8) = 'SM010200'
591      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
592      IF ( ierr .EQ. 0 ) THEN
593         flag_sm010200 = itmp
594         num_sm_levels_input = num_sm_levels_input + 1
595         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
596         DO j = jts , MIN(jde-1,jte)
597            DO i = its , MIN(ide-1,ite)
598               sm_input(i,num_sm_levels_input + 1,j) = grid%sm010200(i,j)
599            END DO
600         END DO
601      END IF
602      flag_name(1:8) = 'SW000010'
603      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
604      IF ( ierr .EQ. 0 ) THEN
605         flag_sw000010 = itmp
606         num_sw_levels_input = num_sw_levels_input + 1
607         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
608         DO j = jts , MIN(jde-1,jte)
609            DO i = its , MIN(ide-1,ite)
610               sw_input(i,num_sw_levels_input + 1,j) = grid%sw000010(i,j)
611            END DO
612         END DO
613      END IF
614      flag_name(1:8) = 'SW010040'
615      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
616      IF ( ierr .EQ. 0 ) THEN
617         flag_sw010040 = itmp
618         num_sw_levels_input = num_sw_levels_input + 1
619         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
620         DO j = jts , MIN(jde-1,jte)
621            DO i = its , MIN(ide-1,ite)
622               sw_input(i,num_sw_levels_input + 1,j) = grid%sw010040(i,j)
623            END DO
624         END DO
625      END IF
626      flag_name(1:8) = 'SW040100'
627      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
628      IF ( ierr .EQ. 0 ) THEN
629         flag_sw040100 = itmp
630         num_sw_levels_input = num_sw_levels_input + 1
631         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
632         DO j = jts , MIN(jde-1,jte)
633            DO i = its , MIN(ide-1,ite)
634               sw_input(i,num_sw_levels_input + 1,j) = grid%sw040100(i,j)
635            END DO
636         END DO
637      END IF
638      flag_name(1:8) = 'SW100200'
639      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
640      IF ( ierr .EQ. 0 ) THEN
641         flag_sw100200 = itmp
642         num_sw_levels_input = num_sw_levels_input + 1
643         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
644         DO j = jts , MIN(jde-1,jte)
645            DO i = its , MIN(ide-1,ite)
646               sw_input(i,num_sw_levels_input + 1,j) = grid%sw100200(i,j)
647            END DO
648         END DO
649      END IF
650      flag_name(1:8) = 'SW010200'
651      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
652      IF ( ierr .EQ. 0 ) THEN
653         flag_sw010200 = itmp
654         num_sw_levels_input = num_sw_levels_input + 1
655         sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
656         DO j = jts , MIN(jde-1,jte)
657            DO i = its , MIN(ide-1,ite)
658               sw_input(i,num_sw_levels_input + 1,j) = grid%sw010200(i,j)
659            END DO
660         END DO
661      END IF
662      flag_name(1:8) = 'ST000007'
663      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
664      IF ( ierr .EQ. 0 ) THEN
665         flag_st000007 = itmp
666         num_st_levels_input = num_st_levels_input + 1
667         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
668         DO j = jts , MIN(jde-1,jte)
669            DO i = its , MIN(ide-1,ite)
670               st_input(i,num_st_levels_input + 1,j) = grid%st000007(i,j)
671            END DO
672         END DO
673      END IF
674      flag_name(1:8) = 'ST007028'
675      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
676      IF ( ierr .EQ. 0 ) THEN
677         flag_st007028 = itmp
678         num_st_levels_input = num_st_levels_input + 1
679         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
680         DO j = jts , MIN(jde-1,jte)
681            DO i = its , MIN(ide-1,ite)
682               st_input(i,num_st_levels_input + 1,j) = grid%st007028(i,j)
683            END DO
684         END DO
685      END IF
686      flag_name(1:8) = 'ST028100'
687      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
688      IF ( ierr .EQ. 0 ) THEN
689         flag_st028100 = itmp
690         num_st_levels_input = num_st_levels_input + 1
691         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
692         DO j = jts , MIN(jde-1,jte)
693            DO i = its , MIN(ide-1,ite)
694               st_input(i,num_st_levels_input + 1,j) = grid%st028100(i,j)
695            END DO
696         END DO
697      END IF
698      flag_name(1:8) = 'ST100255'
699      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
700      IF ( ierr .EQ. 0 ) THEN
701         flag_st100255 = itmp
702         num_st_levels_input = num_st_levels_input + 1
703         st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
704         DO j = jts , MIN(jde-1,jte)
705            DO i = its , MIN(ide-1,ite)
706               st_input(i,num_st_levels_input + 1,j) = grid%st100255(i,j)
707            END DO
708         END DO
709      END IF
710      flag_name(1:8) = 'SM000007'
711      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
712      IF ( ierr .EQ. 0 ) THEN
713         flag_sm000007 = itmp
714         num_sm_levels_input = num_sm_levels_input + 1
715         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
716         DO j = jts , MIN(jde-1,jte)
717            DO i = its , MIN(ide-1,ite)
718               sm_input(i,num_sm_levels_input + 1,j) = grid%sm000007(i,j)
719            END DO
720         END DO
721      END IF
722      flag_name(1:8) = 'SM007028'
723      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
724      IF ( ierr .EQ. 0 ) THEN
725         flag_sm007028 = itmp
726         num_sm_levels_input = num_sm_levels_input + 1
727         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
728         DO j = jts , MIN(jde-1,jte)
729            DO i = its , MIN(ide-1,ite)
730               sm_input(i,num_sm_levels_input + 1,j) = grid%sm007028(i,j)
731            END DO
732         END DO
733      END IF
734      flag_name(1:8) = 'SM028100'
735      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
736      IF ( ierr .EQ. 0 ) THEN
737         flag_sm028100 = itmp
738         num_sm_levels_input = num_sm_levels_input + 1
739         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
740         DO j = jts , MIN(jde-1,jte)
741            DO i = its , MIN(ide-1,ite)
742               sm_input(i,num_sm_levels_input + 1,j) = grid%sm028100(i,j)
743            END DO
744         END DO
745      END IF
746      flag_name(1:8) = 'SM100255'
747      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
748      IF ( ierr .EQ. 0 ) THEN
749         flag_sm100255 = itmp
750         num_sm_levels_input = num_sm_levels_input + 1
751         sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
752         DO j = jts , MIN(jde-1,jte)
753            DO i = its , MIN(ide-1,ite)
754               sm_input(i,num_sm_levels_input + 1,j) = grid%sm100255(i,j)
755            END DO
756         END DO
757      END IF
758      flag_name(1:8) = 'SOILT000'
759      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
760      IF ( ierr .EQ. 0 ) THEN
761         flag_soilt000 = itmp
762         num_st_levels_input = num_st_levels_input + 1
763         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
764         DO j = jts , MIN(jde-1,jte)
765            DO i = its , MIN(ide-1,ite)
766               st_input(i,num_st_levels_input ,j) = grid%soilt000(i,j)
767            END DO
768         END DO
769      END IF
770      flag_name(1:8) = 'SOILT005'
771      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
772      IF ( ierr .EQ. 0 ) THEN
773         flag_soilt005 = itmp
774         num_st_levels_input = num_st_levels_input + 1
775         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
776         DO j = jts , MIN(jde-1,jte)
777            DO i = its , MIN(ide-1,ite)
778               st_input(i,num_st_levels_input ,j) = grid%soilt005(i,j)
779            END DO
780         END DO
781      END IF
782      flag_name(1:8) = 'SOILT020'
783      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
784      IF ( ierr .EQ. 0 ) THEN
785         flag_soilt020 = itmp
786         num_st_levels_input = num_st_levels_input + 1
787         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
788         DO j = jts , MIN(jde-1,jte)
789            DO i = its , MIN(ide-1,ite)
790               st_input(i,num_st_levels_input ,j) = grid%soilt020(i,j)
791            END DO
792         END DO
793      END IF
794      flag_name(1:8) = 'SOILT040'
795      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
796      IF ( ierr .EQ. 0 ) THEN
797         flag_soilt040 = itmp
798         num_st_levels_input = num_st_levels_input + 1
799         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
800         DO j = jts , MIN(jde-1,jte)
801            DO i = its , MIN(ide-1,ite)
802               st_input(i,num_st_levels_input ,j) = grid%soilt040(i,j)
803            END DO
804         END DO
805      END IF
806      flag_name(1:8) = 'SOILT160'
807      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
808      IF ( ierr .EQ. 0 ) THEN
809         flag_soilt160 = itmp
810         num_st_levels_input = num_st_levels_input + 1
811         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
812         DO j = jts , MIN(jde-1,jte)
813            DO i = its , MIN(ide-1,ite)
814               st_input(i,num_st_levels_input ,j) = grid%soilt160(i,j)
815            END DO
816         END DO
817      END IF
818      flag_name(1:8) = 'SOILT300'
819      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
820      IF ( ierr .EQ. 0 ) THEN
821         flag_soilt300 = itmp
822         num_st_levels_input = num_st_levels_input + 1
823         st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
824         DO j = jts , MIN(jde-1,jte)
825            DO i = its , MIN(ide-1,ite)
826               st_input(i,num_st_levels_input ,j) = grid%soilt300(i,j)
827            END DO
828         END DO
829      END IF
830      flag_name(1:8) = 'SOILM000'
831      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
832      IF ( ierr .EQ. 0 ) THEN
833         flag_soilm000 = itmp
834         num_sm_levels_input = num_sm_levels_input + 1
835         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
836         DO j = jts , MIN(jde-1,jte)
837            DO i = its , MIN(ide-1,ite)
838               sm_input(i,num_sm_levels_input ,j) = grid%soilm000(i,j)
839            END DO
840         END DO
841      END IF
842      flag_name(1:8) = 'SOILM005'
843      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
844      IF ( ierr .EQ. 0 ) THEN
845         flag_soilm005 = itmp
846         num_sm_levels_input = num_sm_levels_input + 1
847         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
848         DO j = jts , MIN(jde-1,jte)
849            DO i = its , MIN(ide-1,ite)
850               sm_input(i,num_sm_levels_input ,j) = grid%soilm005(i,j)
851            END DO
852         END DO
853      END IF
854      flag_name(1:8) = 'SOILM020'
855      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
856      IF ( ierr .EQ. 0 ) THEN
857         flag_soilm020 = itmp
858         num_sm_levels_input = num_sm_levels_input + 1
859         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
860         DO j = jts , MIN(jde-1,jte)
861            DO i = its , MIN(ide-1,ite)
862               sm_input(i,num_sm_levels_input ,j) = grid%soilm020(i,j)
863            END DO
864         END DO
865      END IF
866      flag_name(1:8) = 'SOILM040'
867      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
868      IF ( ierr .EQ. 0 ) THEN
869         flag_soilm040 = itmp
870         num_sm_levels_input = num_sm_levels_input + 1
871         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
872         DO j = jts , MIN(jde-1,jte)
873            DO i = its , MIN(ide-1,ite)
874               sm_input(i,num_sm_levels_input ,j) = grid%soilm040(i,j)
875            END DO
876         END DO
877      END IF
878      flag_name(1:8) = 'SOILM160'
879      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
880      IF ( ierr .EQ. 0 ) THEN
881         flag_soilm160 = itmp
882         num_sm_levels_input = num_sm_levels_input + 1
883         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
884         DO j = jts , MIN(jde-1,jte)
885            DO i = its , MIN(ide-1,ite)
886               sm_input(i,num_sm_levels_input ,j) = grid%soilm160(i,j)
887            END DO
888         END DO
889      END IF
890      flag_name(1:8) = 'SOILM300'
891      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
892      IF ( ierr .EQ. 0 ) THEN
893         flag_soilm300 = itmp
894         num_sm_levels_input = num_sm_levels_input + 1
895         sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
896         DO j = jts , MIN(jde-1,jte)
897            DO i = its , MIN(ide-1,ite)
898               sm_input(i,num_sm_levels_input ,j) = grid%soilm300(i,j)
899            END DO
900         END DO
901      END IF
902      flag_name(1:8) = 'SOILW000'
903      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
904      IF ( ierr .EQ. 0 ) THEN
905         flag_soilw000 = itmp
906         num_sw_levels_input = num_sw_levels_input + 1
907         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
908         DO j = jts , MIN(jde-1,jte)
909            DO i = its , MIN(ide-1,ite)
910               sw_input(i,num_sw_levels_input ,j) = grid%soilw000(i,j)
911            END DO
912         END DO
913      END IF
914      flag_name(1:8) = 'SOILW005'
915      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
916      IF ( ierr .EQ. 0 ) THEN
917         flag_soilw005 = itmp
918         num_sw_levels_input = num_sw_levels_input + 1
919         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
920         DO j = jts , MIN(jde-1,jte)
921            DO i = its , MIN(ide-1,ite)
922               sw_input(i,num_sw_levels_input ,j) = grid%soilw005(i,j)
923            END DO
924         END DO
925      END IF
926      flag_name(1:8) = 'SOILW020'
927      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
928      IF ( ierr .EQ. 0 ) THEN
929         flag_soilw020 = itmp
930         num_sw_levels_input = num_sw_levels_input + 1
931         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
932         DO j = jts , MIN(jde-1,jte)
933            DO i = its , MIN(ide-1,ite)
934               sw_input(i,num_sw_levels_input ,j) = grid%soilw020(i,j)
935            END DO
936         END DO
937      END IF
938      flag_name(1:8) = 'SOILW040'
939      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
940      IF ( ierr .EQ. 0 ) THEN
941         flag_soilw040 = itmp
942         num_sw_levels_input = num_sw_levels_input + 1
943         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
944         DO j = jts , MIN(jde-1,jte)
945            DO i = its , MIN(ide-1,ite)
946               sw_input(i,num_sw_levels_input ,j) = grid%soilw040(i,j)
947            END DO
948         END DO
949      END IF
950      flag_name(1:8) = 'SOILW160'
951      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
952      IF ( ierr .EQ. 0 ) THEN
953         flag_soilw160 = itmp
954         num_sw_levels_input = num_sw_levels_input + 1
955         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
956         DO j = jts , MIN(jde-1,jte)
957            DO i = its , MIN(ide-1,ite)
958               sw_input(i,num_sw_levels_input ,j) = grid%soilw160(i,j)
959            END DO
960         END DO
961      END IF
962      flag_name(1:8) = 'SOILW300'
963      CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
964      IF ( ierr .EQ. 0 ) THEN
965         flag_soilw300 = itmp
966         num_sw_levels_input = num_sw_levels_input + 1
967         sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
968         DO j = jts , MIN(jde-1,jte)
969            DO i = its , MIN(ide-1,ite)
970               sw_input(i,num_sw_levels_input ,j) = grid%soilw300(i,j)
971            END DO
972         END DO
973      END IF
974
975      !  OK, let's do a quick sanity check.
976 
977      IF ( ( num_st_levels_input .GT. num_st_levels_alloc ) .OR. &
978           ( num_sm_levels_input .GT. num_sm_levels_alloc ) .OR. &
979           ( num_sw_levels_input .GT. num_sw_levels_alloc ) ) THEN
980         print *,'pain and woe, the soil level allocation is too small'
981         CALL wrf_error_fatal ( 'soil_levels_too_few' )
982      END IF
983
984   END SUBROUTINE optional_lsm_levels
985
986!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
987
988   FUNCTION char2int1( string3 ) RESULT ( int1 )
989      CHARACTER (LEN=3) , INTENT(IN) :: string3
990      INTEGER :: i1 , int1
991      READ(string3,fmt='(I3)') i1
992      int1 = i1
993   END FUNCTION char2int1
994
995!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
996
997   FUNCTION char2int2( string6 ) RESULT ( int1 )
998      CHARACTER (LEN=6) , INTENT(IN) :: string6
999      INTEGER :: i2 , i1 , int1
1000      READ(string6,fmt='(I3,I3)') i1,i2
1001      int1 = ( i2 + i1 ) / 2
1002   END FUNCTION char2int2
1003
1004!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1005
1006END MODULE module_optional_si_input
Note: See TracBrowser for help on using the repository browser.