! ! $Id: getparam.F90 1279 2009-12-10 09:02:56Z aslmd $ ! MODULE getparam #ifdef CPP_IOIPSL USE IOIPSL #else ! if not using IOIPSL, we still need to use (a local version of) getin USE ioipsl_getincom #endif INTERFACE getpar MODULE PROCEDURE ini_getparam,fin_getparam,getparamr,getparami,getparaml END INTERFACE INTEGER, PARAMETER :: out_eff=99 CONTAINS SUBROUTINE ini_getparam(fichier) USE parallel ! IMPLICIT NONE ! CHARACTER*(*) :: fichier IF (mpi_rank==0) OPEN(out_eff,file=fichier,status='unknown',form='formatted') END SUBROUTINE ini_getparam SUBROUTINE fin_getparam USE parallel ! IMPLICIT NONE ! IF (mpi_rank==0) CLOSE(out_eff) END SUBROUTINE fin_getparam SUBROUTINE getparamr(TARGET,def_val,ret_val,comment) USE parallel ! IMPLICIT NONE ! ! Get a real scalar. We first check if we find it ! in the database and if not we get it from the run.def ! ! getinr1d and getinr2d are written on the same pattern ! CHARACTER*(*) :: TARGET REAL :: def_val REAL :: ret_val CHARACTER*(*) :: comment ret_val=def_val call getin(TARGET,ret_val) IF (mpi_rank==0) THEN write(out_eff,*) '######################################' write(out_eff,*) '#### ',comment,' #####' write(out_eff,*) TARGET,'=',ret_val ENDIF END SUBROUTINE getparamr SUBROUTINE getparami(TARGET,def_val,ret_val,comment) USE parallel ! IMPLICIT NONE ! ! Get a real scalar. We first check if we find it ! in the database and if not we get it from the run.def ! ! getinr1d and getinr2d are written on the same pattern ! CHARACTER*(*) :: TARGET INTEGER :: def_val INTEGER :: ret_val CHARACTER*(*) :: comment ret_val=def_val call getin(TARGET,ret_val) IF (mpi_rank==0) THEN write(out_eff,*) '######################################' write(out_eff,*) '#### ',comment,' #####' write(out_eff,*) comment write(out_eff,*) TARGET,'=',ret_val ENDIF END SUBROUTINE getparami SUBROUTINE getparaml(TARGET,def_val,ret_val,comment) USE parallel ! IMPLICIT NONE ! ! Get a real scalar. We first check if we find it ! in the database and if not we get it from the run.def ! ! getinr1d and getinr2d are written on the same pattern ! CHARACTER*(*) :: TARGET LOGICAL :: def_val LOGICAL :: ret_val CHARACTER*(*) :: comment ret_val=def_val call getin(TARGET,ret_val) IF (mpi_rank==0) THEN write(out_eff,*) '######################################' write(out_eff,*) '#### ',comment,' #####' write(out_eff,*) TARGET,'=',ret_val ENDIF END SUBROUTINE getparaml END MODULE getparam