aux_proc.f90

   1
   2    MODULE Auxiliar_Procedures
   3
   4      INTEGER, SAVE :: AISO  !AISO=0, Anisotropic EZZ and ESUM
   5      INTEGER, SAVE :: MTYPE !MTYPE: 1-> ZBI, 2-> WZI, 3-> WZA
   6
   7    CONTAINS
   8
   9     SUBROUTINE Param_Var(Ind_Par,Dep_Par,Step,Relation)
  10     IMPLICIT NONE
  11
  12      REAL, INTENT(INOUT)              :: Ind_Par
  13      REAL, OPTIONAL, INTENT(INOUT)    :: Dep_Par
  14      REAL, INTENT(IN)                 :: Step
  15      CHARACTER (LEN = * ), INTENT(IN) :: Relation
  16
  17
  18      SELECT CASE (TRIM(Relation))
  19
  20        CASE('Single')
  21
  22                Ind_Par = Ind_Par + Step
  23        CASE('Ratio')
  24
  25                IF(.NOT. PRESENT(Dep_Par) ) THEN
  26                        write(6,*)"Box_Size error. Optional argument Dep_Par Needed!"
  27                        STOP
  28                END IF
  29                Dep_Par   = Dep_Par/Ind_Par * (Ind_Par+Step)
  30                Ind_Par = Ind_Par + Step
  31
  32        CASE('Both')
  33
  34                IF(.NOT. PRESENT(Dep_Par) ) THEN
  35                        write(6,*)"Box_Size error. Optional argument Dep_Par Needed!"
  36                        STOP
  37                END IF
  38                Dep_Par = Dep_Par + Step
  39                Ind_Par = Ind_Par + Step
  40
  41       END SELECT
  42
  43       RETURN
  44
  45      END SUBROUTINE Param_Var
  46
  47
  48 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  49 !             Integration: Simpson's method (version REAL)             !
  50 !                          NX mus be even                              !
  51 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  52
  53       REAL FUNCTION RSIMPSON(F,XINC,NX)
  54       IMPLICIT NONE
  55
  56 !!!!! variables 'dummy' y variables internas !!!!!!!!!!!!!!!!!!!!!!!!!!!
  57
  58       INTEGER      NX,I
  59       REAL         F(0:NX),XINC
  60
  61       RSIMPSON = 0.E0
  62       DO I = 1,NX-1,2
  63          RSIMPSON = RSIMPSON+F(I)
  64       END DO
  65
  66       RSIMPSON = 2.E0*RSIMPSON
  67
  68       DO I = 2,NX-2,2
  69          RSIMPSON = RSIMPSON+F(I)
  70       END DO
  71
  72       RSIMPSON = 2.E0*RSIMPSON+F(0)+F(NX)
  73       RSIMPSON = XINC*RSIMPSON/3.E0
  74
  75       RETURN
  76       END FUNCTION RSIMPSON
  77
  78
  79 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  80 !                     Kronecker's delta                                !
  81 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  82
  83       INTEGER FUNCTION IDELTA(I,J)
  84       IMPLICIT NONE
  85
  86 !!!!! 'dummy' and local variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  87
  88       INTEGER      I,J
  89
  90       IDELTA = 0
  91       IF (I.EQ.J) THEN
  92          IDELTA = 1
  93       END IF
  94       RETURN
  95       END FUNCTION IDELTA
  96
  97 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  98
  99 ! Internal subroutine - checks error status after each netcdf, prints out text message each time
 100 ! an error code is returned.
 101       SUBROUTINE check(status)
 102          USE NETCDF, ONLY: nf90_noerr, nf90_strerror
 103         integer, intent ( in) :: status
 104
 105         if(status /= nf90_noerr) then
 106           print *, trim(nf90_strerror(status))
 107         end if
 108       END SUBROUTINE check
 109
 110     END MODULE Auxiliar_Procedures