Ignore:
Timestamp:
Jul 24, 2024, 2:54:37 PM (2 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move ismin, ismax, minmax into new lmdz_libmath.f90
(lint) uppercase fortran keywords

Location:
LMDZ6/branches/Amaury_dev/libf/misc
Files:
1 added
5 deleted
11 edited
2 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90

    r5113 r5116  
    1515    CHARACTER(LEN = *), INTENT(IN) :: string
    1616    LOGICAL, INTENT(IN) :: n1
    17     if (.not. n1) then
     17    if (.not. n1) THEN
    1818      write (*, *) 'nrerror: an assertion failed with this tag:', &
    1919              string
    … …  
    2626    CHARACTER(LEN = *), INTENT(IN) :: string
    2727    LOGICAL, INTENT(IN) :: n1, n2
    28     if (.not. (n1 .and. n2)) then
     28    if (.not. (n1 .and. n2)) THEN
    2929      write (*, *) 'nrerror: an assertion failed with this tag:', &
    3030              string
    … …  
    3737    CHARACTER(LEN = *), INTENT(IN) :: string
    3838    LOGICAL, INTENT(IN) :: n1, n2, n3
    39     if (.not. (n1 .and. n2 .and. n3)) then
     39    if (.not. (n1 .and. n2 .and. n3)) THEN
    4040      write (*, *) 'nrerror: an assertion failed with this tag:', &
    4141              string
    … …  
    4848    CHARACTER(LEN = *), INTENT(IN) :: string
    4949    LOGICAL, INTENT(IN) :: n1, n2, n3, n4
    50     if (.not. (n1 .and. n2 .and. n3 .and. n4)) then
     50    if (.not. (n1 .and. n2 .and. n3 .and. n4)) THEN
    5151      write (*, *) 'nrerror: an assertion failed with this tag:', &
    5252              string
    … …  
    5959    CHARACTER(LEN = *), INTENT(IN) :: string
    6060    LOGICAL, DIMENSION(:), INTENT(IN) :: n
    61     if (.not. all(n)) then
     61    if (.not. all(n)) THEN
    6262      write (*, *) 'nrerror: an assertion failed with this tag:', &
    6363              string

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90

    r5114 r5116  
    11module lmdz_coefpoly
    22
    3   IMPLICIT NONE
     3  IMPLICIT NONE; PRIVATE
     4  PUBLIC coefpoly
    45
    56contains
    … …  
    2526    ! a0, a1, a2, a3.
    2627
    27     use nrtype, only: k8
     28    use nrtype, ONLY: k8
    2829
    2930    REAL(K8), intent(in) :: xf1, xf2, xprim1, xprim2, xtild1, xtild2

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_formcoord.f90

    r5115 r5116  
     1MODULE lmdz_formcoord
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC formcoord
     4CONTAINS
    15
    2 ! $Header$
     6  SUBROUTINE formcoord(unit, n, x, a, rev, text)
     7    IMPLICIT NONE
     8    INTEGER :: n, unit, ndec
     9    logical :: rev
     10    REAL :: x(n), a
     11    CHARACTER(LEN = 4) :: text
    312
    4 SUBROUTINE formcoord(unit,n,x,a,rev,text)
    5   IMPLICIT NONE
    6   integer :: n,unit,ndec
    7   logical :: rev
    8   real :: x(n),a
    9   character(len=4) :: text
     13    INTEGER :: i, id, i1, i2, in
     14    REAL :: dx, dxmin
    1015
    11   integer :: i,id,i1,i2,in
    12   real :: dx,dxmin
     16    IF(rev) THEN
     17      id = -1
     18      i1 = n
     19      i2 = n - 1
     20      in = 1
     21      WRITE(unit, 3000) text(1:1)
     22    else
     23      id = 1
     24      i1 = 1
     25      i2 = 2
     26      in = n
     27    endif
    1328
    14   if(rev) then
    15      id=-1
    16      i1=n
    17      i2=n-1
    18      in=1
    19      write(unit,3000) text(1:1)
    20   else
    21      id=1
    22      i1=1
    23      i2=2
    24      in=n
    25   endif
     29    if (n<2) THEN
     30      ndec = 1
     31      WRITE(unit, 1000) text, n, x(1) * a
     32    else
     33      dxmin = abs(x(2) - x(1))
     34      do i = 2, n - 1
     35        dx = abs(x(i + 1) - x(i))
     36        if (dx<dxmin) dxmin = dx
     37      enddo
    2638
    27   if (n<2) then
    28      ndec=1
    29      write(unit,1000) text,n,x(1)*a
    30   else
    31      dxmin=abs(x(2)-x(1))
    32      do i=2,n-1
    33         dx=abs(x(i+1)-x(i))
    34         if (dx<dxmin) dxmin=dx
    35      enddo
     39      ndec = -log10(dxmin) + 2
     40      IF(mod(n, 6)==1) THEN
     41        WRITE(unit, 1000) text, n, x(i1) * a
     42        WRITE(unit, 2000) (x(i) * a, i=i2, in, id)
     43      else
     44        WRITE(unit, 1000) text, n
     45        WRITE(unit, 2000) (x(i) * a, i=i1, in, id)
     46      endif
     47    endif
    3648
    37      ndec=-log10(dxmin)+2
    38      if(mod(n,6)==1) then
    39         write(unit,1000) text,n,x(i1)*a
    40         write(unit,2000) (x(i)*a,i=i2,in,id)
    41      else
    42         write(unit,1000) text,n
    43         write(unit,2000) (x(i)*a,i=i1,in,id)
    44      endif
    45   endif
     49    1000   format(a4, 2x, i4, ' LEVELS', 43x, f12.2)
     50    2000   format(6f12.2)
     51    3000   format('FORMAT ', a1, 'REV')
    4652
    47 1000   format(a4,2x,i4,' LEVELS',43x,f12.2)
    48 2000   format(6f12.2)
    49   !1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
    50   !2000  format(6f12.<ndec>)
    51 3000   format('FORMAT ',a1,'REV')
    52 
    53 
    54 end subroutine formcoord
     53  END SUBROUTINE formcoord
     54END MODULE lmdz_formcoord

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_interpolation.f90

    r5115 r5116  
    11! $Id$
    2 module interpolation
     2module lmdz_interpolation
    33
    44  ! From Press et al., 1996, version 2.10a
    55  ! B3 Interpolation and Extrapolation
    66
    7   IMPLICIT NONE
     7  IMPLICIT NONE; PRIVATE
     8  PUBLIC locate, hunt
    89
    910contains
    1011
    11   pure FUNCTION locate(xx,x)
     12  pure FUNCTION locate(xx, x)
    1213
    1314    REAL, DIMENSION(:), INTENT(IN) :: xx
    … …  
    2223    ! See notes.
    2324
    24     INTEGER  n,jl,jm,ju
     25    INTEGER  n, jl, jm, ju
    2526    LOGICAL  ascnd
    2627
    2728    !----------------------------
    2829
    29     n=size(xx)
     30    n = size(xx)
    3031    ascnd = (xx(n) >= xx(1))
    3132    ! (True if ascending order of table, false otherwise.)
    3233    ! Initialize lower and upper limits:
    33     jl=0
    34     ju=n+1
    35     do while (ju-jl > 1)
    36        jm=(ju+jl)/2 ! Compute a midpoint,
    37        if (ascnd .eqv. (x >= xx(jm))) then
    38           jl=jm ! and replace either the lower limit
    39        else
    40           ju=jm ! or the upper limit, as appropriate.
    41        end if
     34    jl = 0
     35    ju = n + 1
     36    do while (ju - jl > 1)
     37      jm = (ju + jl) / 2 ! Compute a midpoint,
     38      if (ascnd .eqv. (x >= xx(jm))) THEN
     39        jl = jm ! and replace either the lower limit
     40      else
     41        ju = jm ! or the upper limit, as appropriate.
     42      end if
    4243    END DO
    4344    ! {ju == jl + 1}
    … …  
    4849
    4950    ! Then set the output, being careful with the endpoints:
    50     if (x == xx(1)) then
    51        locate=1
    52     else if (x == xx(n)) then
    53        locate=n-1
     51    if (x == xx(1)) THEN
     52      locate = 1
     53    else if (x == xx(n)) THEN
     54      locate = n - 1
    5455    else
    55        locate=jl
     56      locate = jl
    5657    end if
    5758
    … …  
    6061  !***************************
    6162
    62   pure SUBROUTINE hunt(xx,x,jlo)
     63  pure SUBROUTINE hunt(xx, x, jlo)
    6364
    6465    ! Given an array xx(1:N ), and given a value x, returns a value
    … …  
    7273    REAL, INTENT(IN) :: x
    7374    REAL, DIMENSION(:), INTENT(IN) :: xx
    74     INTEGER  n,inc,jhi,jm
     75    INTEGER  n, inc, jhi, jm
    7576    LOGICAL  ascnd, hunt_up
    7677
    7778    !-----------------------------------------------------
    7879
    79     n=size(xx)
     80    n = size(xx)
    8081    ascnd = (xx(n) >= xx(1))
    8182    ! (True if ascending order of table, false otherwise.)
    82     if (jlo < 0 .or. jlo > n) then
    83        ! Input guess not useful. Go immediately to bisection.
    84        jlo=0
    85        jhi=n+1
     83    if (jlo < 0 .or. jlo > n) THEN
     84      ! Input guess not useful. Go immediately to bisection.
     85      jlo = 0
     86      jhi = n + 1
    8687    else
    87        inc=1 ! Set the hunting increment.
    88        if (jlo == 0) then
    89           hunt_up = .TRUE.
    90        else
    91           hunt_up = x >= xx(jlo) .eqv. ascnd
    92        end if
    93        if (hunt_up) then ! Hunt up:
    94           do
    95              jhi=jlo+inc
    96              if (jhi > n) then ! Done hunting, since off end of table.
    97                 jhi=n+1
    98                 exit
    99              else
    100                 if (x < xx(jhi) .eqv. ascnd) exit
    101                 jlo=jhi ! Not done hunting,
    102                 inc=inc+inc ! so double the increment
    103              end if
    104           END DO ! and try again.
    105        else ! Hunt down:
    106           jhi=jlo
    107           do
    108              jlo=jhi-inc
    109              if (jlo < 1) then ! Done hunting, since off end of table.
    110                 jlo=0
    111                 exit
    112              else
    113                 if (x >= xx(jlo) .eqv. ascnd) exit
    114                 jhi=jlo ! Not done hunting,
    115                 inc=inc+inc ! so double the increment
    116              end if
    117           END DO ! and try again.
    118        end if
     88      inc = 1 ! Set the hunting increment.
     89      if (jlo == 0) THEN
     90        hunt_up = .TRUE.
     91      else
     92        hunt_up = x >= xx(jlo) .eqv. ascnd
     93      end if
     94      if (hunt_up) then ! Hunt up:
     95        do
     96          jhi = jlo + inc
     97          if (jhi > n) then ! Done hunting, since off end of table.
     98            jhi = n + 1
     99            exit
     100          else
     101            if (x < xx(jhi) .eqv. ascnd) exit
     102            jlo = jhi ! Not done hunting,
     103            inc = inc + inc ! so double the increment
     104          end if
     105        END DO ! and try again.
     106      else ! Hunt down:
     107        jhi = jlo
     108        do
     109          jlo = jhi - inc
     110          if (jlo < 1) then ! Done hunting, since off end of table.
     111            jlo = 0
     112            exit
     113          else
     114            if (x >= xx(jlo) .eqv. ascnd) exit
     115            jhi = jlo ! Not done hunting,
     116            inc = inc + inc ! so double the increment
     117          end if
     118        END DO ! and try again.
     119      end if
    119120    end if ! Done hunting, value bracketed.
    120121
    121122    do ! Hunt is done, so begin the final bisection phase:
    122        if (jhi-jlo <= 1) then
    123           if (x == xx(n)) jlo=n-1
    124           if (x == xx(1)) jlo=1
    125           exit
    126        else
    127           jm=(jhi+jlo)/2
    128           if (x >= xx(jm) .eqv. ascnd) then
    129              jlo=jm
    130           else
    131              jhi=jm
    132           end if
    133        end if
     123      if (jhi - jlo <= 1) THEN
     124        if (x == xx(n)) jlo = n - 1
     125        if (x == xx(1)) jlo = 1
     126        exit
     127      else
     128        jm = (jhi + jlo) / 2
     129        if (x >= xx(jm) .eqv. ascnd) THEN
     130          jlo = jm
     131        else
     132          jhi = jm
     133        end if
     134      end if
    134135    END DO
    135136
    136137  END SUBROUTINE hunt
    137138
    138 end module interpolation
     139end module lmdz_interpolation

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90

    r5115 r5116  
    489489    ! the points  XE.
    490490
    491     use lmdz_assert_eq, only: assert_eq
     491    use lmdz_assert_eq, ONLY: assert_eq
    492492
    493493    REAL, intent(in) :: X(:) ! real array of independent variable values
    … …  
    572572    ! 2001, pages 43-47
    573573
    574     use lmdz_assert_eq, only: assert_eq
     574    use lmdz_assert_eq, ONLY: assert_eq
    575575
    576576    real, intent(in) :: x(:)
    … …  
    638638
    639639    n = assert_eq(size(x), size(f), "pchsp_95 n")
    640     if ((ibeg == 1 .or. ibeg == 2) .and. .not. present(vc_beg)) then
     640    if ((ibeg == 1 .or. ibeg == 2) .and. .not. present(vc_beg)) THEN
    641641      print *, "vc_beg required for IBEG = 1 or 2"
    642642      stop 1
    643643    end if
    644     if ((iend == 1 .or. iend == 2) .and. .not. present(vc_end)) then
     644    if ((iend == 1 .or. iend == 2) .and. .not. present(vc_end)) THEN
    645645      print *, "vc_end required for IEND = 1 or 2"
    646646      stop 1

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90

    r5115 r5116  
    748748    !     intrinsic function LEN is used to determine its length.  If
    749749    !         it is zero, PREFIX is not used.  If it exceeds 16 or if
    750     !     LEN(PREFIX) exceeds 16, only the first 16 characters will be
     750    !     LEN(PREFIX) exceeds 16, ONLY the first 16 characters will be
    751751    !     used.  If NPREF is positive and the length of PREFIX is less
    752752    !     than NPREF, a copy of PREFIX extended with blanks to length
    … …  
    10551055  END SUBROUTINE XERCNT
    10561056
     1057  !DECK J4SAVE
     1058  FUNCTION J4SAVE(IWHICH, IVALUE, ISET)
     1059    IMPLICIT NONE
     1060    !***BEGIN PROLOGUE  J4SAVE
     1061    !***SUBSIDIARY
     1062    !***PURPOSE  Save or reCALL global variables needed by error
     1063    ! handling routines.
     1064    !***LIBRARY   SLATEC (XERROR)
     1065    !***TYPE      INTEGER (J4SAVE-I)
     1066    !***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
     1067    !***AUTHOR  Jones, R. E., (SNLA)
     1068    !***DESCRIPTION
     1069    !
     1070    ! Abstract
     1071    !    J4SAVE saves and recalls several global variables needed
     1072    !    by the library error handling routines.
     1073    !
     1074    ! Description of Parameters
     1075    !  --Input--
     1076    !    IWHICH - Index of item desired.
     1077    !            = 1 Refers to current error number.
     1078    !            = 2 Refers to current error control flag.
     1079    !            = 3 Refers to current unit number to which error
     1080    !                messages are to be sent.  (0 means use standard.)
     1081    !            = 4 Refers to the maximum number of times any
     1082    !                 message is to be printed (as set by XERMAX).
     1083    !            = 5 Refers to the total number of units to which
     1084    !                 each error message is to be written.
     1085    !            = 6 Refers to the 2nd unit for error messages
     1086    !            = 7 Refers to the 3rd unit for error messages
     1087    !            = 8 Refers to the 4th unit for error messages
     1088    !            = 9 Refers to the 5th unit for error messages
     1089    !    IVALUE - The value to be set for the IWHICH-th parameter,
     1090    !             if ISET is .TRUE. .
     1091    !    ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
     1092    !             given the value, IVALUE.  If ISET=.FALSE., the
     1093    !             IWHICH-th parameter will be unchanged, and IVALUE
     1094    !             is a dummy parameter.
     1095    !  --Output--
     1096    !    The (old) value of the IWHICH-th parameter will be returned
     1097    !    in the function value, J4SAVE.
     1098    !
     1099    !***SEE ALSO  XERMSG
     1100    !***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
     1101    !             Error-handling Package, SAND82-0800, Sandia
     1102    !             Laboratories, 1982.
     1103    !***ROUTINES CALLED  (NONE)
     1104    !***REVISION HISTORY  (YYMMDD)
     1105    !   790801  DATE WRITTEN
     1106    !   891214  Prologue converted to Version 4.0 format.  (BAB)
     1107    !   900205  Minor modifications to prologue.  (WRB)
     1108    !   900402  Added TYPE section.  (WRB)
     1109    !   910411  Added KEYWORDS section.  (WRB)
     1110    !   920501  Reformatted the REFERENCES section.  (WRB)
     1111    !***END PROLOGUE  J4SAVE
     1112    LOGICAL :: ISET
     1113    INTEGER :: IPARAM(9)
     1114    SAVE IPARAM
     1115    DATA IPARAM(1), IPARAM(2), IPARAM(3), IPARAM(4)/0, 2, 0, 10/
     1116    DATA IPARAM(5)/1/
     1117    DATA IPARAM(6), IPARAM(7), IPARAM(8), IPARAM(9)/0, 0, 0, 0/
     1118    INTEGER :: J4SAVE, IWHICH, IVALUE
     1119    !***FIRST EXECUTABLE STATEMENT  J4SAVE
     1120    J4SAVE = IPARAM(IWHICH)
     1121    IF (ISET) IPARAM(IWHICH) = IVALUE
     1122
     1123  END FUNCTION J4SAVE
     1124
    10571125
    10581126END MODULE lmdz_xer

  • LMDZ6/branches/Amaury_dev/libf/misc/q_sat.f90

    r5105 r5116  
    1919  !======================================================================
    2020
    21   integer :: np
     21  INTEGER :: np
    2222  REAL :: temp(np),pres(np),qsat(np)
    2323
    … …  
    3939  PARAMETER (retv=28.9644/18.0153 - 1.0)
    4040
    41   real :: zqsat
    42   integer :: ip
     41  REAL :: zqsat
     42  INTEGER :: ip
    4343
    4444  ! ------------------------------------------------------------------
    … …  
    4747  do ip=1,np
    4848
    49    ! write(*,*)'kelvin,millibar=',kelvin,millibar
    50    !  write(*,*)'temp,pres=',temp(ip),pres(ip)
     49   ! WRITE(*,*)'kelvin,millibar=',kelvin,millibar
     50   !  WRITE(*,*)'temp,pres=',temp(ip),pres(ip)
    5151
    5252     IF (temp(ip) <= rtt) THEN
    … …  
    6363
    6464     qsat(ip)= zqsat
    65    ! write(*,*)'qsat=',qsat(ip)
     65   ! WRITE(*,*)'qsat=',qsat(ip)
    6666
    6767  enddo

  • LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90

    r5113 r5116  
    3030    ! "vs" has rank 1.
    3131
    32     use lmdz_assert_eq, only: assert_eq
    33     use lmdz_assert, only: assert
    34     use interpolation, only: locate
     32    use lmdz_assert_eq, ONLY: assert_eq
     33    use lmdz_assert, ONLY: assert
     34    use lmdz_interpolation, ONLY: locate
    3535
    3636    real, intent(in):: vs(:) ! values of steps on the source grid
    … …  
    8181    END DO
    8282
    83   end function regr11_step_av
     83  END FUNCTION regr11_step_av
    8484
    8585  !********************************************
    … …  
    8989    ! "vs" has rank 2.
    9090
    91     use lmdz_assert_eq, only: assert_eq
    92     use lmdz_assert, only: assert
    93     use interpolation, only: locate
     91    use lmdz_assert_eq, ONLY: assert_eq
     92    use lmdz_assert, ONLY: assert
     93    use lmdz_interpolation, ONLY: locate
    9494
    9595    real, intent(in):: vs(:, :) ! values of steps on the source grid
    … …  
    141141    END DO
    142142
    143   end function regr12_step_av
     143  END FUNCTION regr12_step_av
    144144
    145145  !********************************************
    … …  
    149149    ! "vs" has rank 3.
    150150
    151     use lmdz_assert_eq, only: assert_eq
    152     use lmdz_assert, only: assert
    153     use interpolation, only: locate
     151    use lmdz_assert_eq, ONLY: assert_eq
     152    use lmdz_assert, ONLY: assert
     153    use lmdz_interpolation, ONLY: locate
    154154
    155155    real, intent(in):: vs(:, :, :) ! values of steps on the source grid
    … …  
    202202    END DO
    203203
    204   end function regr13_step_av
     204  END FUNCTION regr13_step_av
    205205
    206206  !********************************************
    … …  
    210210    ! "vs" has rank 4.
    211211
    212     use lmdz_assert_eq, only: assert_eq
    213     use lmdz_assert, only: assert
    214     use interpolation, only: locate
     212    use lmdz_assert_eq, ONLY: assert_eq
     213    use lmdz_assert, ONLY: assert
     214    use lmdz_interpolation, ONLY: locate
    215215
    216216    real, intent(in):: vs(:, :, :, :) ! values of steps on the source grid
    … …  
    264264    END DO
    265265
    266   end function regr14_step_av
     266  END FUNCTION regr14_step_av
    267267
    268268end module regr1_step_av_m

  • LMDZ6/branches/Amaury_dev/libf/misc/regr_conserv_m.F90

    r5113 r5116  
    33  USE lmdz_assert_eq,   ONLY: assert_eq
    44  USE lmdz_assert,      ONLY: assert
    5   USE interpolation, ONLY: locate
     5  use lmdz_interpolation, ONLY: locate
    66
    77  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90

    r5113 r5116  
    33  USE lmdz_assert_eq,   ONLY: assert_eq
    44  USE lmdz_assert,      ONLY: assert
    5   USE interpolation, ONLY: hunt
     5  use lmdz_interpolation, ONLY: hunt
    66
    77  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90

    r5113 r5116  
    2020#ifdef USE_VT
    2121    include 'VT.inc'
    22     integer :: ierr
     22    INTEGER :: ierr
    2323   
    2424    CALL VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
    … …  
    3333#ifdef USE_MPE
    3434    include 'mpe_logf.h'
    35     integer :: ierr,i
     35    INTEGER :: ierr,i
    3636   
    3737    DO i=1,nb_inst
    … …  
    5454#ifdef USE_VT   
    5555    include 'VT.inc'
    56     integer :: ierr
     56    INTEGER :: ierr
    5757   
    5858    CALL VTBEGIN(number,ierr)
    … …  
    6060#ifdef USE_MPE
    6161    include 'mpe_logf.h'
    62     integer :: ierr,i
     62    INTEGER :: ierr,i
    6363    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
    6464#endif
    … …  
    7171#ifdef USE_VT   
    7272    include 'VT.inc'
    73     integer :: ierr
     73    INTEGER :: ierr
    7474   
    7575    CALL VTEND(number,ierr)
    … …  
    7878#ifdef USE_MPE
    7979    include 'mpe_logf.h'
    80     integer :: ierr,i
     80    INTEGER :: ierr,i
    8181    ierr = MPE_Log_event( MPE_end(number), 0, '' )
    8282#endif

  • LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90

    r5113 r5116  
    1212  integer, dimension(MaxWriteField), save :: FieldVarId
    1313  integer, dimension(MaxWriteField), save :: FieldIndex
    14   character(len = 255), dimension(MaxWriteField) :: FieldName
     14  CHARACTER(LEN = 255), dimension(MaxWriteField) :: FieldName
    1515
    1616  integer, save :: NbField = 0
    … …  
    2323  function GetFieldIndex(name)
    2424    IMPLICIT NONE
    25     integer :: GetFieldindex
    26     character(len = *) :: name
    27 
    28     character(len = 255) :: TrueName
    29     integer :: i
     25    INTEGER :: GetFieldindex
     26    CHARACTER(LEN = *) :: name
     27
     28    CHARACTER(LEN = 255) :: TrueName
     29    INTEGER :: i
    3030
    3131    TrueName = TRIM(ADJUSTL(name))
    … …  
    3333    GetFieldIndex = -1
    3434    do i = 1, NbField
    35       if (TrueName==FieldName(i)) then
     35      if (TrueName==FieldName(i)) THEN
    3636        GetFieldIndex = i
    3737        exit
    3838      endif
    3939    enddo
    40   end function GetFieldIndex
     40  END FUNCTION GetFieldIndex
    4141
    4242  subroutine WriteField3d(name, Field)
    4343    IMPLICIT NONE
    44     character(len = *) :: name
     44    CHARACTER(LEN = *) :: name
    4545    real, dimension(:, :, :) :: Field
    4646    integer, dimension(3) :: Dim
    … …  
    4949    CALL WriteField_gen(name, Field, Dim(1), Dim(2), Dim(3))
    5050
    51   end subroutine WriteField3d
     51  END SUBROUTINE WriteField3d
    5252
    5353  subroutine WriteField2d(name, Field)
    5454    IMPLICIT NONE
    55     character(len = *) :: name
     55    CHARACTER(LEN = *) :: name
    5656    real, dimension(:, :) :: Field
    5757    integer, dimension(2) :: Dim
    … …  
    6060    CALL WriteField_gen(name, Field, Dim(1), Dim(2), 1)
    6161
    62   end subroutine WriteField2d
     62  END SUBROUTINE WriteField2d
    6363
    6464  subroutine WriteField1d(name, Field)
    6565    IMPLICIT NONE
    66     character(len = *) :: name
     66    CHARACTER(LEN = *) :: name
    6767    real, dimension(:) :: Field
    6868    integer, dimension(1) :: Dim
    … …  
    7171    CALL WriteField_gen(name, Field, Dim(1), 1, 1)
    7272
    73   end subroutine WriteField1d
     73  END SUBROUTINE WriteField1d
    7474
    7575  subroutine WriteField_gen(name, Field, dimx, dimy, dimz)
    7676    IMPLICIT NONE
    77     character(len = *) :: name
    78     integer :: dimx, dimy, dimz
     77    CHARACTER(LEN = *) :: name
     78    INTEGER :: dimx, dimy, dimz
    7979    real, dimension(dimx, dimy, dimz) :: Field
    8080    integer, dimension(dimx * dimy * dimz) :: ndex
    81     integer :: status
    82     integer :: index
    83     integer :: start(4)
    84     integer :: count(4)
     81    INTEGER :: status
     82    INTEGER :: index
     83    INTEGER :: start(4)
     84    INTEGER :: count(4)
    8585
    8686    Index = GetFieldIndex(name)
    87     if (Index==-1) then
     87    if (Index==-1) THEN
    8888      CALL CreateNewField(name, dimx, dimy, dimz)
    8989      Index = GetFieldIndex(name)
    … …  
    105105    status = nf90_sync(FieldId(Index))
    106106
    107   end subroutine WriteField_gen
     107  END SUBROUTINE WriteField_gen
    108108
    109109  subroutine CreateNewField(name, dimx, dimy, dimz)
    110110    IMPLICIT NONE
    111     character(len = *) :: name
    112     integer :: dimx, dimy, dimz
    113     integer :: TabDim(4)
    114     integer :: status
     111    CHARACTER(LEN = *) :: name
     112    INTEGER :: dimx, dimy, dimz
     113    INTEGER :: TabDim(4)
     114    INTEGER :: status
    115115
    116116    NbField = NbField + 1
    … …  
    126126    status = nf90_enddef(FieldId(NbField))
    127127
    128   end subroutine CreateNewField
     128  END SUBROUTINE CreateNewField
    129129
    130130  subroutine write_field1D(name, Field)
    … …  
    132132
    133133    integer, parameter :: MaxDim = 1
    134     character(len = *) :: name
     134    CHARACTER(LEN = *) :: name
    135135    real, dimension(:) :: Field
    136136    real, dimension(:), allocatable :: New_Field
    137     character(len = 20) :: str
     137    CHARACTER(LEN = 20) :: str
    138138    integer, dimension(MaxDim) :: Dim
    139     integer :: i, nb
     139    INTEGER :: i, nb
    140140    integer, parameter :: id = 10
    141141    integer, parameter :: NbCol = 4
    142     integer :: ColumnSize
    143     integer :: pos
    144     character(len = 255) :: form
    145     character(len = 255) :: MaxLen
     142    INTEGER :: ColumnSize
     143    INTEGER :: pos
     144    CHARACTER(LEN = 255) :: form
     145    CHARACTER(LEN = 255) :: MaxLen
    146146
    147147    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
    … …  
    155155      nb = nb + 1
    156156
    157       if (MOD(nb, NbCol)==0) then
     157      if (MOD(nb, NbCol)==0) THEN
    158158        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16,/)'
    159159        Pos = 2
    … …  
    167167    close(id)
    168168
    169   end subroutine write_field1D
     169  END SUBROUTINE write_field1D
    170170
    171171  subroutine write_field2D(name, Field)
    … …  
    173173
    174174    integer, parameter :: MaxDim = 2
    175     character(len = *) :: name
     175    CHARACTER(LEN = *) :: name
    176176    real, dimension(:, :) :: Field
    177177    real, dimension(:, :), allocatable :: New_Field
    178     character(len = 20) :: str
     178    CHARACTER(LEN = 20) :: str
    179179    integer, dimension(MaxDim) :: Dim
    180     integer :: i, j, nb
     180    INTEGER :: i, j, nb
    181181    integer, parameter :: id = 10
    182182    integer, parameter :: NbCol = 4
    183     integer :: ColumnSize
    184     integer :: pos, offset
    185     character(len = 255) :: form
    186     character(len = 255) :: spacing
     183    INTEGER :: ColumnSize
     184    INTEGER :: pos, offset
     185    CHARACTER(LEN = 255) :: form
     186    CHARACTER(LEN = 255) :: spacing
    187187
    188188    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
    … …  
    201201        nb = nb + 1
    202202
    203         if (MOD(nb, NbCol)==0) then
     203        if (MOD(nb, NbCol)==0) THEN
    204204          form = '(t' // trim(int2str(pos)) // &
    205205                  ',"(' // trim(int2str(j)) // ','          &
    … …  
    218218        write (id, form, advance = 'no') Field(j, i)
    219219      enddo
    220       if (MOD(nb, NbCol)==0) then
     220      if (MOD(nb, NbCol)==0) THEN
    221221        write (id, spacing)
    222222      else
    … …  
    226226    enddo
    227227
    228   end subroutine write_field2D
     228  END SUBROUTINE write_field2D
    229229
    230230  subroutine write_field3D(name, Field)
    … …  
    232232
    233233    integer, parameter :: MaxDim = 3
    234     character(len = *) :: name
     234    CHARACTER(LEN = *) :: name
    235235    real, dimension(:, :, :) :: Field
    236236    real, dimension(:, :, :), allocatable :: New_Field
    237237    integer, dimension(MaxDim) :: Dim
    238     integer :: i, j, k, nb
     238    INTEGER :: i, j, k, nb
    239239    integer, parameter :: id = 10
    240240    integer, parameter :: NbCol = 4
    241     integer :: ColumnSize
    242     integer :: pos, offset
    243     character(len = 255) :: form
    244     character(len = 255) :: spacing
     241    INTEGER :: ColumnSize
     242    INTEGER :: pos, offset
     243    CHARACTER(LEN = 255) :: form
     244    CHARACTER(LEN = 255) :: spacing
    245245
    246246    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
    … …  
    264264          nb = nb + 1
    265265
    266           if (MOD(nb, NbCol)==0) then
     266          if (MOD(nb, NbCol)==0) THEN
    267267            form = '(t' // trim(int2str(pos)) // &
    268268                    ',"(' // trim(int2str(k)) // ','          &
    … …  
    284284          write (id, form, advance = 'no') Field(k, j, i)
    285285        enddo
    286         if (MOD(nb, NbCol)==0) then
     286        if (MOD(nb, NbCol)==0) THEN
    287287          write (id, spacing)
    288288        else
    … …  
    296296    close(id)
    297297
    298   end subroutine write_field3D
     298  END SUBROUTINE write_field3D
    299299
    300300end module write_field

  • LMDZ6/branches/Amaury_dev/libf/misc/wxios.F90

    r5112 r5116  
    359359    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    360360    SUBROUTINE wxios_domain_param(dom_id)
    361        USE dimphy, only: klon
     361       USE dimphy, ONLY: klon
    362362       USE lmdz_phys_transfert_para, ONLY: gather, bcast
    363        USE lmdz_phys_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
     363       USE lmdz_phys_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
    364364                                     mpi_size, mpi_rank, klon_mpi, &
    365365                                     is_sequential, is_south_pole_dyn
    366        USE lmdz_grid_phy, only: nbp_lon, nbp_lat, klon_glo
     366       USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
    367367       USE lmdz_print_control, ONLY: prt_level, lunout
    368368       USE lmdz_geometry
    … …  
    390390        io_lat(1)=rlat_glo(1)
    391391        io_lat(nbp_lat)=rlat_glo(klon_glo)
    392         IF ((nbp_lon*nbp_lat) > 1) then
     392        IF ((nbp_lon*nbp_lat) > 1) THEN
    393393          DO i=2,nbp_lat-1
    394394            io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
    … …  
    532532       
    533533        ! Ehouarn: New way to declare axis, without axis_group:
    534         if (PRESENT(positif) .AND. PRESENT(bnds)) then
     534        if (PRESENT(positif) .AND. PRESENT(bnds)) THEN
    535535          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
    536536                                  positive=positif, bounds=bnds)
    537         else if (PRESENT(positif)) then
     537        else if (PRESENT(positif)) THEN
    538538          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
    539539                                  positive=positif)
    540         else if (PRESENT(bnds)) then
     540        else if (PRESENT(bnds)) THEN
    541541          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
    542542                                  bounds=bnds)
    … …  
    605605    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    606606    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
    607         USE netcdf, only: nf90_fill_real
     607        USE netcdf, ONLY: nf90_fill_real
    608608
    609609        IMPLICIT NONE
Note: See TracChangeset for help on using the changeset viewer.