source: CONFIG_DEVT/IPSLCM6.5_work_ENSEMBLES/modeles/ORCHIDEE/src_sechiba/sechiba_io_p.f90 @ 5501

Last change on this file since 5501 was 5501, checked in by aclsce, 4 years ago

First import of IPSLCM6.5_work_ENSEMBLES working configuration

  • Property svn:executable set to *
File size: 24.8 KB
Line 
1! ================================================================================================================================
2!  MODULE       : sechiba_io_p
3!
4!  CONTACT      : orchidee-help _at_ listes.ipsl.fr
5!
6!  LICENCE      : IPSL (2006)
7!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF   To be used for intializing variables not read available in the restart file
10!!
11!!\n DESCRIPTION: This module contains the interface to setvar_p to be used for intializing variables if they were
12!!                not found in the restart file. The variable will only be modified if it was not found in the restart
13!!                file (i.e. if it is eqaul val_exp).
14!!
15!!                Syntax : CALL setvar_p (var, val_exp, key_wd, val_put)
16!!                  var : the variable to initialize; It can be an integer or a real, a scalar or have 1 or 2 dimensions
17!!                  val_exp : the value set by restget_p if the variable was not found in the restart file (do not change this)
18!!                  key_wd  : parameter name to be searched for in run.def
19!!                  val_put : a value to be used if the kew_wd was not found in run.def. val_put must have the same or
20!!                            smaller rank as var
21!!
22!!                Note that setvar_p must always be called by all processes because it contains call to getin_p.
23!!                - The variable var, will only be modified if before the call it is equal to val_exp. Otherwise nothing is done.
24!!                - If var is equal to val_exp and if key_wd is not equal "NO_KEYWORD" or "NOKEYWORD", then the value for key_wd
25!!                  is read from run.def using getin_p and used to initialize var.
26!!                - If key_wd is not found in run.def or if key_wd="NO_KEYWORD" or "NOKEYWORD", then the val_put will be used to
27!!                  initialize var.
28!!
29!!                The interface will automatically call the right subroutine depending on the type of input variables.
30!!
31!! REFERENCE(S) : None
32!!
33!! SVN          :
34!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/sechiba_io_p.f90 $
35!! $Date: 2017-06-28 16:04:50 +0200 (Wed, 28 Jun 2017) $
36!! $Revision: 4470 $
37!! \n
38!_ ================================================================================================================================
39
40MODULE sechiba_io_p
41
42  USE defprec
43  USE constantes
44  USE ioipsl
45  USE ioipsl_para
46  USE mod_orchidee_para
47
48  IMPLICIT NONE
49
50  PRIVATE
51  PUBLIC setvar_p
52
53  INTERFACE setvar_p
54    MODULE PROCEDURE i0setvar_p, i10setvar_p, i20setvar_p, i11setvar_p, i21setvar_p
55    MODULE PROCEDURE r0setvar_p, r10setvar_p, r20setvar_p, r11setvar_p, r21setvar_p, r22setvar_p, r30setvar_p
56  END INTERFACE
57
58  LOGICAL, SAVE                  :: long_print_setvar_p=.FALSE.  !! change to true to have more information
59!$OMP THREADPRIVATE(long_print_setvar_p)
60
61CONTAINS 
62
63!!  =============================================================================================================================
64!! SUBROUTINE:    i0setvar_p
65!!
66!>\BRIEF          Subroutine for initializing an integer scalar variable with a scalar integer.
67!!
68!! DESCRIPTION:   Subroutine for initializing an integer scalar variable with a scalar integer.
69!!                This subroutine must be called by all processes.
70!! \n
71!_ ==============================================================================================================================
72SUBROUTINE i0setvar_p (var, val_exp, key_wd, val_put)
73
74  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
75  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
76  CHARACTER(LEN=*), INTENT(in)                    :: key_wd               !! The Key word we will look for
77  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
78
79  INTEGER(i_std)                                  :: val_tmp
80  INTEGER(i_std)                                  :: is_key
81
82  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
83 
84  IF (long_print_setvar_p) WRITE (numout,*) "i0setvar :", key_wd, val_exp, val_put
85
86  val_tmp = val_put
87
88  IF ( var == val_exp ) THEN
89     IF ( is_key <= 0 ) THEN
90        CALL getin_p(key_wd,  val_tmp)
91     ENDIF
92     var = val_tmp
93  END IF
94 
95END SUBROUTINE i0setvar_p
96
97
98!!  =============================================================================================================================
99!! SUBROUTINE:    i10setvar_p
100!!
101!>\BRIEF          Subroutine for initializing an integer 1D array with a integer scalar variable.
102!!
103!! DESCRIPTION:   Subroutine for initializing an integer 1D array with a integer scalar variable.
104!!                This subroutine must be called by all processes.
105!! \n
106!_ ==============================================================================================================================
107SUBROUTINE i10setvar_p (var, val_exp, key_wd, val_put)
108
109  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
110  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
111  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
112  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
113 
114  INTEGER(i_std)                                  :: val_tmp
115  INTEGER(i_std)                                  :: is_key
116
117  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
118
119  IF (long_print_setvar_p) WRITE (numout,*) "i10setvar :", key_wd, val_exp, val_put
120
121  val_tmp = val_put
122
123  IF ( ALL( var(:) == val_exp ) ) THEN
124     IF ( is_key <= 0 ) THEN
125       CALL getin_p(key_wd,  val_tmp)
126     ENDIF
127     var(:) = val_tmp
128  END IF
129 
130END SUBROUTINE i10setvar_p
131
132
133!!  =============================================================================================================================
134!! SUBROUTINE:    i11setvar_p
135!!
136!>\BRIEF          Subroutine for initializing an integer 1D array with another integer 1D array.
137!!
138!! DESCRIPTION:   Subroutine for initializing an integer 1D array with another integer 1D array.
139!!                This subroutine must be called by all processes.
140!! \n
141!_ ==============================================================================================================================
142SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
143 
144  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
145  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
146  CHARACTER(LEN=*), INTENT(in)                    :: key_wd              !! The Key word we will look for
147  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
148  LOGICAL,        OPTIONAL                        :: is_grid             !! Parameter present indicates a setvar for a grid variable
149
150  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
151  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp_g
152  INTEGER(i_std)                                  :: is_key
153
154  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
155 
156  IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
157
158  ALLOCATE(val_tmp(SIZE(val_put)))
159  val_tmp(:) = val_put(:)
160
161  IF ( ALL( var(:) == val_exp ) ) THEN
162     IF ( is_key <= 0 ) THEN
163        IF (PRESENT(is_grid) ) THEN
164           IF (is_root_prc) THEN
165              ALLOCATE( val_tmp_g(nbp_glo) )
166           ELSE
167              ALLOCATE( val_tmp_g(1) )
168           ENDIF
169           CALL gather( val_tmp,val_tmp_g )
170           IF (is_root_prc) &
171              CALL getin(key_wd,  val_tmp_g)
172           CALL scatter( val_tmp,val_tmp_g )
173           DEALLOCATE( val_tmp_g )
174        ELSE
175           CALL getin_p(key_wd,  val_tmp)
176        ENDIF
177     ENDIF
178     var(:) = val_tmp (:)
179  END IF
180
181  DEALLOCATE(val_tmp)
182 
183END SUBROUTINE i11setvar_p
184
185
186!!  =============================================================================================================================
187!! SUBROUTINE:    i20setvar_p
188!!
189!>\BRIEF          Subroutine for initializing an integer 2D variable with a scalar integer variable.
190!!
191!! DESCRIPTION:   Subroutine for initializing an integer 2D variable with a scalar integer variable.
192!!                This subroutine must be called by all processes.
193!! \n
194!_ ==============================================================================================================================
195SUBROUTINE i20setvar_p (var, val_exp, key_wd, val_put)
196 
197  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
198  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
199  CHARACTER(LEN=*), INTENT(in)                    :: key_wd               !! The Key word we will look for
200  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to be used as default
201
202  INTEGER(i_std)                                  :: val_tmp
203  INTEGER(i_std)                                  :: is_key
204
205  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
206 
207  IF (long_print_setvar_p) WRITE (numout,*) "i20setvar :", key_wd, val_exp, val_put
208
209  val_tmp = val_put
210
211  IF ( ALL( var(:,:) == val_exp ) ) THEN
212     IF ( is_key <= 0 ) THEN
213       CALL getin_p(key_wd,  val_tmp)
214     ENDIF
215     var(:,:) = val_tmp
216  END IF
217 
218END SUBROUTINE i20setvar_p
219
220
221!!  =============================================================================================================================
222!! SUBROUTINE:    i21setvar_p
223!!
224!>\BRIEF          Subroutine for initialieing an 2D integer variable with a 1D array integer.
225!!
226!! DESCRIPTION:   Subroutine for initialieing an 2D integer variable with a 1D array integer.
227!!                This subroutine must be called by all processes.
228!!                Row or column depending size of 1D array to stored.
229!!
230!!                example: 1D 1,2,3     2D is 1, 2, 3,
231!!                                            1, 2, 3
232!!
233!!                example: 1D 1,2,3     2D is 1, 1,
234!!                                            2, 2,
235!!                                            3, 3
236!! \n
237!_ ==============================================================================================================================
238SUBROUTINE i21setvar_p (var, val_exp, key_wd, val_put, is_grid)
239 
240  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
241  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
242  CHARACTER(LEN=*), INTENT(in)                    :: key_wd               !! The Key word we will look for
243  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
244  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable
245 
246  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
247  INTEGER(i_std)                                  :: is_key
248
249  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
250
251  ! test if the 1D array dimension is compatible with first or second
252  ! dimension of the 2D array
253
254  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, val_put
255
256  ALLOCATE(val_tmp(SIZE(val_put)))
257  val_tmp(:) = val_put(:)
258
259  IF (SIZE(val_put)==SIZE(var,1)) THEN 
260      !
261      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
262      !                                1., 2., 3.
263      !
264      IF ( ALL( var(:,:) == val_exp ) ) THEN
265         IF ( is_key <= 0 ) THEN
266           CALL getin_p(key_wd,  val_tmp)
267         ENDIF
268         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
269      END IF
270  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
271      !
272      ! example: 1D 1.,2.,3.     2D is 1., 1.,
273      !                                2., 2.,
274      !                                3., 3.
275      !
276      IF ( ALL( var(:,:) == val_exp ) ) THEN
277         IF ( is_key <= 0 ) THEN
278           CALL getin_p(key_wd,  val_tmp)
279         ENDIF
280         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
281      END IF
282  ELSE
283      WRITE (numout,*) ' incompatible dimension var and val_put'
284      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
285      WRITE (numout,*) ' val_put ', SIZE(val_put)
286      STOP 'setvar'
287  END IF
288
289  DEALLOCATE(val_tmp)
290 
291END SUBROUTINE i21setvar_p
292
293
294!!  =============================================================================================================================
295!! SUBROUTINE:    r0setvar_p
296!!
297!>\BRIEF          Subroutine for initializing a real scalar variable.
298!!
299!! DESCRIPTION:   Subroutine for initializing a real scalar variable with a real scalar variable.
300!!                This subroutine must be called by all processes.
301!! \n
302!_ ==============================================================================================================================
303SUBROUTINE r0setvar_p (var, val_exp, key_wd, val_put)
304 
305  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
306  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
307  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
308  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
309 
310  REAL(r_std)                                  :: val_tmp
311  INTEGER(i_std)                                     :: is_key
312
313  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
314
315  IF (long_print_setvar_p) WRITE (numout,*) "r0setvar :", key_wd, val_exp, val_put
316
317  val_tmp = val_put
318
319  IF ( var==val_exp ) THEN
320     IF ( is_key <= 0 ) THEN
321       CALL getin_p(key_wd,  val_tmp)
322     ENDIF
323     var = val_tmp
324  END IF
325 
326END SUBROUTINE r0setvar_p
327
328
329!!  =============================================================================================================================
330!! SUBROUTINE:    r10setvar_p
331!!
332!>\BRIEF          Subroutine for initializing an real 1D array with a real scalar variable.
333!!
334!! DESCRIPTION:   Subroutine for initializing an real 1D array with a real scalar variable.
335!!                This subroutine must be called by all processes.
336!! \n
337!_ ==============================================================================================================================
338SUBROUTINE r10setvar_p (var, val_exp, key_wd, val_put)
339 
340  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
341  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
342  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
343  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
344   
345  REAL(r_std)                                  :: val_tmp
346  INTEGER(i_std)                               :: is_key
347
348  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
349 
350  IF (long_print_setvar_p) WRITE (numout,*) "r10setvar :", key_wd, val_exp, val_put
351
352  val_tmp = val_put
353
354  IF ( ALL( var(:) == val_exp ) ) THEN
355     IF ( is_key <= 0 ) THEN
356       CALL getin_p(key_wd,  val_tmp)
357     ENDIF
358     var(:) = val_tmp
359  END IF
360 
361END SUBROUTINE r10setvar_p
362
363
364!!  =============================================================================================================================
365!! SUBROUTINE:    r11setvar_p
366!!
367!>\BRIEF          Subroutine for initializing an real 1D array with another real 1D array.
368!!
369!! DESCRIPTION:   Subroutine for initializing an real 1D array with another real 1D array.
370!!                This subroutine must be called by all processes.
371!! \n
372!_ ==============================================================================================================================
373SUBROUTINE r11setvar_p (var, val_exp, key_wd, val_put, is_grid)
374 
375  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
376  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
377  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
378  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
379  LOGICAL,        OPTIONAL                     :: is_grid             !! Parameter present indicates a setvar for a grid variable
380
381  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
382  INTEGER(i_std)                               :: is_key
383
384  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
385   
386  IF (long_print_setvar_p) WRITE (numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
387
388  ALLOCATE(val_tmp(SIZE(val_put)))
389  val_tmp(:) = val_put(:)
390
391  IF ( ALL( var(:) == val_exp ) ) THEN
392     IF ( is_key <= 0 ) THEN
393       CALL getin_p(key_wd,  val_tmp)
394     ENDIF
395     var(:) = val_tmp (:)
396  END IF
397
398  DEALLOCATE(val_tmp)
399 
400END SUBROUTINE r11setvar_p
401
402
403!!  =============================================================================================================================
404!! SUBROUTINE:    r20setvar_p
405!!
406!>\BRIEF          Subroutine for initializing an real 2D variable with a scalar real variable.
407!!
408!! DESCRIPTION:   Subroutine for initializing an real 2D variable with a scalar real variable.
409!!                This subroutine must be called by all processes.
410!! \n
411!_ ==============================================================================================================================
412SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
413 
414  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
415  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
416  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
417  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
418 
419  REAL(r_std)                                  :: val_tmp 
420  INTEGER(i_std)                               :: is_key
421
422  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
423 
424  IF (long_print_setvar_p) WRITE (numout,*) "r20setvar :", key_wd, val_exp, val_put
425
426  val_tmp = val_put
427
428  IF ( ALL( var(:,:) == val_exp ) ) THEN
429     IF ( is_key <= 0 ) THEN
430       CALL getin_p(key_wd,  val_tmp)
431     ENDIF
432     var(:,:) = val_tmp
433  END IF
434 
435END SUBROUTINE r20setvar_p
436
437!!  =============================================================================================================================
438!! SUBROUTINE:    r21setvar_p
439!!
440!>\BRIEF          Subroutine for initialieing an 2D real variable with a 1D array real.
441!!
442!! DESCRIPTION:   Subroutine for initialieing an 2D real variable with a 1D array real.
443!!                This subroutine must be called by all processes.
444!!                Row or column depending size of 1D array to stored.
445!!
446!!                example: 1D 1,2,3     2D is 1, 2, 3,
447!!                                            1, 2, 3
448!!
449!!                example: 1D 1,2,3     2D is 1, 1,
450!!                                            2, 2,
451!!                                            3, 3
452!! \n
453!_ ==============================================================================================================================
454SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
455 
456  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
457  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
458  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
459  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
460  LOGICAL,        OPTIONAL                     :: is_grid              !! Parameter present indicates a setvar for a grid variable
461
462  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
463  INTEGER(i_std)                               :: is_key
464
465  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
466 
467  ! test if the 1D array dimension is compatible with first or second
468  ! dimension of the 2D array
469
470  IF (long_print_setvar_p) WRITE (numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
471
472  ALLOCATE(val_tmp(SIZE(val_put)))
473  val_tmp(:) = val_put(:)
474
475  IF (SIZE(val_put)==SIZE(var,1)) THEN 
476      !
477      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
478      !                                1., 2., 3.
479      !
480      IF ( ALL( var(:,:) == val_exp ) ) THEN
481         IF ( is_key <= 0 ) THEN
482           CALL getin_p(key_wd,  val_tmp)
483         ENDIF
484         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
485      END IF
486  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
487      !
488      ! example: 1D 1.,2.,3.     2D is 1., 1.,
489      !                                2., 2.,
490      !                                3., 3.
491      !
492      IF ( ALL( var(:,:) == val_exp ) ) THEN
493         IF ( is_key <= 0 ) THEN
494           CALL getin_p(key_wd,  val_tmp)
495         ENDIF
496         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
497      END IF
498  ELSE
499      WRITE (numout,*) ' incompatible dimension var and val_put'
500      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
501      WRITE (numout,*) ' val_put ', SIZE(val_put)
502      STOP 'setvar'
503  END IF
504
505  DEALLOCATE(val_tmp)
506 
507END SUBROUTINE r21setvar_p
508
509
510!!  =============================================================================================================================
511!! SUBROUTINE:    r22setvar_p
512!!
513!>\BRIEF          Subroutine for initializing a 2D real variable with a real with the same size.
514!!
515!! DESCRIPTION:   Subroutine for initializing a 2D real variable with a real with the same size or by reading an scalar value
516!!                from run.def if key_wd is different from "NO_KEYWORD" or "NOKEYWORD".
517!!                It is not possible to read a 2D variable from run.def.
518!!                This subroutine must be called by all processes.
519!! \n
520!_ ==============================================================================================================================
521SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put)
522
523  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
524  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
525  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
526  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
527  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
528  REAL(r_std)                                  :: val_scal            !! Temporary variable to read a scalar value from run.def
529  INTEGER(i_std)                               :: is_key
530
531  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
532
533  IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
534
535  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
536  val_tmp(:,:) = val_put(:,:)
537
538  IF ( ALL( var(:,:) == val_exp ) ) THEN
539     IF ( is_key <= 0 ) THEN
540        ! This case only read a scalar value with getin
541        val_scal=val_exp
542        CALL getin_p(key_wd, val_scal)
543        ! If a value was found in run.def, then set val_tmp to this value.
544        IF (val_scal/=val_exp) val_tmp(:,:)=val_scal 
545     ENDIF
546     var(:,:) = val_tmp(:,:)
547  END IF
548
549  DEALLOCATE(val_tmp)
550 
551END SUBROUTINE r22setvar_p
552
553!!  =============================================================================================================================
554!! SUBROUTINE:    r30setvar_p
555!!
556!>\BRIEF          Subroutine for initializing an real 3D variable with a scalar real variable.
557!!
558!! DESCRIPTION:   Subroutine for initializing an real 3D variable with a scalar real variable.
559!!                This subroutine must be called by all processes.
560!! \n
561!_ ==============================================================================================================================
562SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
563
564  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
565  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
566  CHARACTER(LEN=*), INTENT(in)                 :: key_wd               !! The Key word we will look for
567  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
568
569  REAL(r_std)                                  :: val_tmp 
570  INTEGER(i_std)                               :: is_key
571
572  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
573
574  IF (long_print_setvar_p) WRITE(numout,*) 'r30setvar',val_exp, val_put
575
576  val_tmp = val_put
577
578  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
579     IF ( is_key <= 0 ) THEN
580       CALL getin_p(key_wd,  val_tmp)
581     ENDIF
582     var(:,:,:) = val_tmp
583  END IF
584
585END SUBROUTINE r30setvar_p
586
587END MODULE sechiba_io_p
Note: See TracBrowser for help on using the repository browser.