source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/getparam.F90 @ 5101

Last change on this file since 5101 was 5101, checked in by abarral, 4 months ago

Handle DEBUG_IO in lmdz_cppkeys_wrapper.F90
Transform some files .F -> .[fF]90
[ne compile pas à cause de writefield_u non défini - en attente de réponse Laurent]

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 2.7 KB
RevLine 
[5099]1
[1632]2! $Id: getparam.F90 1279 2009-12-10 09:02:56Z fairhead $
[5099]3
[1632]4MODULE getparam
5#ifdef CPP_IOIPSL
6   USE IOIPSL
7#else
8! if not using IOIPSL, we still need to use (a local version of) getin
9   USE ioipsl_getincom
10#endif
11
12   INTERFACE getpar
[2094]13     MODULE PROCEDURE getparamr,getparami,getparaml
[1632]14   END INTERFACE
[2094]15   private getparamr,getparami,getparaml
[1632]16
17   INTEGER, PARAMETER :: out_eff=99
18
19CONTAINS
20  SUBROUTINE ini_getparam(fichier)
[1823]21  USE parallel_lmdz
[5099]22
[1632]23    IMPLICIT NONE
[5099]24
[1632]25    CHARACTER*(*) :: fichier
26    IF (mpi_rank==0) OPEN(out_eff,file=fichier,status='unknown',form='formatted')
27   
28  END SUBROUTINE ini_getparam
29
30  SUBROUTINE fin_getparam
[1823]31  USE parallel_lmdz
[5099]32
[1632]33    IMPLICIT NONE
[5099]34
[1632]35      IF (mpi_rank==0) CLOSE(out_eff)
36
37  END SUBROUTINE fin_getparam
38
39  SUBROUTINE getparamr(TARGET,def_val,ret_val,comment)
[1823]40  USE parallel_lmdz
[5099]41
[1632]42    IMPLICIT NONE
[5099]43
[1632]44    !   Get a real scalar. We first check if we find it
45    !   in the database and if not we get it from the run.def
[5099]46
[1632]47    !   getinr1d and getinr2d are written on the same pattern
[5099]48
[1632]49    CHARACTER*(*) :: TARGET
50    REAL :: def_val
51    REAL :: ret_val
52    CHARACTER*(*) :: comment
53
54    ret_val=def_val
[5101]55    CALL getin(TARGET,ret_val)
[1632]56
57    IF (mpi_rank==0) THEN
58      write(out_eff,*) '######################################'
59      write(out_eff,*) '#### ',comment,' #####'
60      write(out_eff,*) TARGET,'=',ret_val
61    ENDIF
62   
63  END SUBROUTINE getparamr
64
65  SUBROUTINE getparami(TARGET,def_val,ret_val,comment)
[1823]66  USE parallel_lmdz
[5099]67
[1632]68    IMPLICIT NONE
[5099]69
[1632]70    !   Get a real scalar. We first check if we find it
71    !   in the database and if not we get it from the run.def
[5099]72
[1632]73    !   getinr1d and getinr2d are written on the same pattern
[5099]74
[1632]75    CHARACTER*(*) :: TARGET
76    INTEGER :: def_val
77    INTEGER :: ret_val
78    CHARACTER*(*) :: comment
79
80    ret_val=def_val
[5101]81    CALL getin(TARGET,ret_val)
[1632]82
83    IF (mpi_rank==0) THEN
84      write(out_eff,*) '######################################'
85      write(out_eff,*) '#### ',comment,' #####'
86      write(out_eff,*) comment
87      write(out_eff,*) TARGET,'=',ret_val
88    ENDIF
89   
90  END SUBROUTINE getparami
91
92  SUBROUTINE getparaml(TARGET,def_val,ret_val,comment)
[1823]93  USE parallel_lmdz
[5099]94
[1632]95    IMPLICIT NONE
[5099]96
[1632]97    !   Get a real scalar. We first check if we find it
98    !   in the database and if not we get it from the run.def
[5099]99
[1632]100    !   getinr1d and getinr2d are written on the same pattern
[5099]101
[1632]102    CHARACTER*(*) :: TARGET
103    LOGICAL :: def_val
104    LOGICAL :: ret_val
105    CHARACTER*(*) :: comment
106
107    ret_val=def_val
[5101]108    CALL getin(TARGET,ret_val)
[1632]109
110    IF (mpi_rank==0) THEN
111      write(out_eff,*) '######################################'
112      write(out_eff,*) '#### ',comment,' #####'
113      write(out_eff,*) TARGET,'=',ret_val
114    ENDIF
115       
116  END SUBROUTINE getparaml
117
118
119END MODULE getparam
Note: See TracBrowser for help on using the repository browser.