Ignore:
Timestamp:
Mar 5, 2014, 2:19:12 PM (10 years ago)
Author:
lguez
Message:

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

File:
1 moved

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/phylmd/printflag.F90

    r1988 r1992  
    1 !
     1
    22! $Header$
    3 !
    4        SUBROUTINE  printflag( tabcntr0, radpas,
    5      ,                        ok_journe,ok_instan,ok_region        )
    6 c
    73
    8 c
    9 c      Auteur :  P. Le Van
    10 
    11        IMPLICIT NONE
    12 
    13        REAL tabcntr0( 100 )
    14        LOGICAL cycle_diurn0,soil_model0,new_oliq0,ok_orodr0
    15        LOGICAL ok_orolf0,ok_limitvr0
    16        LOGICAL ok_journe,ok_instan,ok_region
    17        INTEGER radpas , radpas0
    18 c
    19 #include "clesphys.h"
    20 c
    21 c
    22        PRINT 100
    23        PRINT *,' *******************************************************
    24      ,************'
    25        PRINT *,' ********   Choix  des principales  cles de la physique
    26      ,   *********'
    27        PRINT *,' *******************************************************
    28      ,************'
    29        PRINT 100
    30        PRINT 10, cycle_diurne,  soil_model 
    31        PRINT 100
    32 
    33        IF   (    iflag_con.EQ. 1 )   THEN
    34            PRINT *,' *****           Shema  convection   LMD           
    35      ,          ******'
    36        ELSE IF ( iflag_con.EQ. 2 )   THEN
    37            PRINT *,' *****           Shema  convection  Tiedtke 
    38      ,          ******'
    39        ELSE IF ( iflag_con.GE. 3 )   THEN
    40            PRINT *,' *****           Shema  convection    Emanuel     
    41      ,          ******'
    42        ENDIF
    43        PRINT 100
    44 
    45        PRINT 11, new_oliq, ok_orodr, ok_orolf   
    46        PRINT 100
    47 
    48        PRINT 7,  ok_limitvrai   
    49        PRINT 100
    50 
    51        PRINT 12, nbapp_rad
    52        PRINT 100
    53 
    54        PRINT 8, radpas
    55        PRINT 100
    56 
    57        PRINT 4,ok_journe,ok_instan,ok_region
    58        PRINT 100
    59        PRINT 100
    60 c
    61 c
    62         cycle_diurn0  = .FALSE.
    63         soil_model0   = .FALSE.
    64         new_oliq0     = .FALSE.
    65         ok_orodr0     = .FALSE.
    66         ok_orolf0     = .FALSE.
    67         ok_limitvr0   = .FALSE.
    68 
    69         IF( tabcntr0( 7 ).EQ. 1. )   cycle_diurn0 = .TRUE.
    70         IF( tabcntr0( 8 ).EQ. 1. )    soil_model0 = .TRUE.
    71         IF( tabcntr0( 9 ).EQ. 1. )      new_oliq0 = .TRUE.
    72         IF( tabcntr0(10 ).EQ. 1. )      ok_orodr0 = .TRUE.
    73         IF( tabcntr0(11 ).EQ. 1. )      ok_orolf0 = .TRUE.
    74         IF( tabcntr0(12 ).EQ. 1. )    ok_limitvr0 = .TRUE.
    75 
    76         PRINT *,' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    77      ,$$$$$$$$$$$$$'
    78         PRINT 100
    79 c
    80        IF( INT( tabcntr0( 5 ) ) .NE. iflag_con  )   THEN
    81         PRINT 20, INT(tabcntr0(5)), iflag_con
    82         PRINT 100
    83        ENDIF
    84 
    85        IF( INT( tabcntr0( 6 ) ) .NE. nbapp_rad  )   THEN
    86         PRINT 21,  INT(tabcntr0(6)), nbapp_rad
    87 !        radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
    88         PRINT 100
    89 !        PRINT 22, radpas0, radpas
    90         PRINT 100
    91        ENDIF
    92 
    93        IF( cycle_diurn0.AND..NOT.cycle_diurne.OR..NOT.cycle_diurn0.AND.
    94      ,        cycle_diurne )     THEN
    95         PRINT 13, cycle_diurn0, cycle_diurne
    96         PRINT 100
    97        ENDIF
    98 
    99        IF( soil_model0.AND..NOT.soil_model.OR..NOT.soil_model0.AND.
    100      ,        soil_model )     THEN
    101         PRINT 14, soil_model0, soil_model
    102         PRINT 100
    103        ENDIF
    104 
    105        IF( new_oliq0.AND..NOT.new_oliq.OR..NOT.new_oliq0.AND.
    106      ,        new_oliq )     THEN
    107         PRINT 16, new_oliq0, new_oliq
    108         PRINT 100
    109        ENDIF
    110 
    111        IF( ok_orodr0.AND..NOT.ok_orodr.OR..NOT.ok_orodr0.AND.
    112      ,        ok_orodr )     THEN
    113         PRINT 15, ok_orodr0, ok_orodr
    114         PRINT 100
    115        ENDIF
    116 
    117        IF( ok_orolf0.AND..NOT.ok_orolf.OR..NOT.ok_orolf0.AND.
    118      ,        ok_orolf )     THEN
    119         PRINT 17, ok_orolf0, ok_orolf
    120         PRINT 100
    121        ENDIF
    122 
    123        IF( ok_limitvr0.AND..NOT.ok_limitvrai.OR..NOT.ok_limitvr0.
    124      ,     AND.ok_limitvrai )     THEN
    125         PRINT 18, ok_limitvr0, ok_limitvrai
    126         PRINT 100
    127        ENDIF
    128 
    129        PRINT 100
    130        PRINT *,' *******************************************************
    131      ,************'
    132        PRINT 100
    133 
    134  4    FORMAT(2x,5("*"),'  ok_journe= ',l3,3x,',ok_instan = ',
    135      , l3,3x,',ok_region = ',l3,3x,5("*") )
    136 
    137  7     FORMAT(2x,5("*"),15x,'      ok_limitvrai   = ',l3,16x,5("*") )
    138 
    139  8     FORMAT(2x,'*****             radpas    =                      ' ,
    140      , i4,6x,' *****')
    141 
    142  10    FORMAT(2x,5("*"),'    Cycle_diurne = ',l3,4x,', Soil_model = ',
    143      , l3,12x,6("*") )
     4SUBROUTINE printflag(tabcntr0, radpas, ok_journe, ok_instan, ok_region)
    1445
    1456
    146  11    FORMAT(2x,5("*"),'  new_oliq = ',l3,3x,', Ok_orodr = ',
    147      , l3,3x,', Ok_orolf = ',l3,3x,5("*") )
     7
     8  ! Auteur :  P. Le Van
     9
     10  IMPLICIT NONE
     11
     12  REAL tabcntr0(100)
     13  LOGICAL cycle_diurn0, soil_model0, new_oliq0, ok_orodr0
     14  LOGICAL ok_orolf0, ok_limitvr0
     15  LOGICAL ok_journe, ok_instan, ok_region
     16  INTEGER radpas, radpas0
     17
     18  include "clesphys.h"
    14819
    14920
    150  12    FORMAT(2x,'*****  Nb d appels /jour des routines de rayonn. = ' ,
    151      , i4,6x,' *****')
     21  PRINT 100
     22  PRINT *, ' ******************************************************* &
     23    &                                                         &
     24    &  ************'
     25  PRINT *, ' ********   Choix  des principales  cles de la physique &
     26    &                                                         &
     27    &      *********'
     28  PRINT *, ' ******************************************************* &
     29    &                                                         &
     30    &  ************'
     31  PRINT 100
     32  PRINT 10, cycle_diurne, soil_model
     33  PRINT 100
    15234
    153  13    FORMAT(2x,'$$$$$$$$   Attention !!  cycle_diurne  different  sur',
    154      , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
     35  IF (iflag_con==1) THEN
     36    PRINT *, ' *****           Shema  convection   LMD        &
     37      &                                                       &
     38      &                   ******'
     39  ELSE IF (iflag_con==2) THEN
     40    PRINT *, ' *****           Shema  convection  Tiedtke     &
     41      &                                                       &
     42      &                   ******'
     43  ELSE IF (iflag_con>=3) THEN
     44    PRINT *, ' *****           Shema  convection    Emanuel   &
     45      &                                                       &
     46      &                   ******'
     47  END IF
     48  PRINT 100
    15549
    156  14    FORMAT(2x,'$$$$$$$$   Attention !!    soil_model  different  sur',
    157      , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
     50  PRINT 11, new_oliq, ok_orodr, ok_orolf
     51  PRINT 100
    15852
    159  15    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orodr  different  sur',
    160      , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
     53  PRINT 7, ok_limitvrai
     54  PRINT 100
    16155
    162  16    FORMAT(2x,'$$$$$$$$   Attention !!      new_oliq  different  sur',
    163      , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
     56  PRINT 12, nbapp_rad
     57  PRINT 100
    16458
    165  17    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orolf  different  sur',
    166      , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
     59  PRINT 8, radpas
     60  PRINT 100
    16761
    168  18    FORMAT(2x,'$$$$$$$$   Attention !!  ok_limitvrai  different  sur',
    169      , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
     62  PRINT 4, ok_journe, ok_instan, ok_region
     63  PRINT 100
     64  PRINT 100
    17065
    171  20    FORMAT(/2x,'$$$$$$$$   Attention !!    iflag_con  different  sur',
    172      , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
    17366
    174  21    FORMAT(2x,'$$$$$$$$   Attention !!     nbapp_rad  different  sur',
    175      , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
     67  cycle_diurn0 = .FALSE.
     68  soil_model0 = .FALSE.
     69  new_oliq0 = .FALSE.
     70  ok_orodr0 = .FALSE.
     71  ok_orolf0 = .FALSE.
     72  ok_limitvr0 = .FALSE.
    17673
    177  22    FORMAT(2x,'$$$$$$$$   Attention !!        radpas  different  sur',
    178      , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
     74  IF (tabcntr0(7)==1.) cycle_diurn0 = .TRUE.
     75  IF (tabcntr0(8)==1.) soil_model0 = .TRUE.
     76  IF (tabcntr0(9)==1.) new_oliq0 = .TRUE.
     77  IF (tabcntr0(10)==1.) ok_orodr0 = .TRUE.
     78  IF (tabcntr0(11)==1.) ok_orolf0 = .TRUE.
     79  IF (tabcntr0(12)==1.) ok_limitvr0 = .TRUE.
    17980
    180  100   FORMAT(/)
     81  PRINT *, ' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ &
     82    &                                                         &
     83    & $$$$$$$$$$$$$'
     84  PRINT 100
    18185
    182        RETURN
    183        END
     86  IF (int(tabcntr0(5))/=iflag_con) THEN
     87    PRINT 20, int(tabcntr0(5)), iflag_con
     88    PRINT 100
     89  END IF
     90
     91  IF (int(tabcntr0(6))/=nbapp_rad) THEN
     92    PRINT 21, int(tabcntr0(6)), nbapp_rad
     93    ! radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
     94    PRINT 100
     95    ! PRINT 22, radpas0, radpas
     96    PRINT 100
     97  END IF
     98
     99  IF (cycle_diurn0 .AND. .NOT. cycle_diurne .OR. .NOT. cycle_diurn0 .AND. &
     100      cycle_diurne) THEN
     101    PRINT 13, cycle_diurn0, cycle_diurne
     102    PRINT 100
     103  END IF
     104
     105  IF (soil_model0 .AND. .NOT. soil_model .OR. .NOT. soil_model0 .AND. &
     106      soil_model) THEN
     107    PRINT 14, soil_model0, soil_model
     108    PRINT 100
     109  END IF
     110
     111  IF (new_oliq0 .AND. .NOT. new_oliq .OR. .NOT. new_oliq0 .AND. new_oliq) &
     112      THEN
     113    PRINT 16, new_oliq0, new_oliq
     114    PRINT 100
     115  END IF
     116
     117  IF (ok_orodr0 .AND. .NOT. ok_orodr .OR. .NOT. ok_orodr0 .AND. ok_orodr) &
     118      THEN
     119    PRINT 15, ok_orodr0, ok_orodr
     120    PRINT 100
     121  END IF
     122
     123  IF (ok_orolf0 .AND. .NOT. ok_orolf .OR. .NOT. ok_orolf0 .AND. ok_orolf) &
     124      THEN
     125    PRINT 17, ok_orolf0, ok_orolf
     126    PRINT 100
     127  END IF
     128
     129  IF (ok_limitvr0 .AND. .NOT. ok_limitvrai .OR. .NOT. ok_limitvr0 .AND. &
     130      ok_limitvrai) THEN
     131    PRINT 18, ok_limitvr0, ok_limitvrai
     132    PRINT 100
     133  END IF
     134
     135  PRINT 100
     136  PRINT *, ' ******************************************************* &
     137    &                                                         &
     138    &  ************'
     139  PRINT 100
     140
     1414 FORMAT (2X, 5('*'), '  ok_journe= ', L3, 3X, ',ok_instan = ', L3, 3X, &
     142    ',ok_region = ', L3, 3X, 5('*'))
     143
     1447 FORMAT (2X, 5('*'), 15X, '      ok_limitvrai   = ', L3, 16X, 5('*'))
     145
     1468 FORMAT (2X, '*****             radpas    =                      ', I4, 6X, &
     147    ' *****')
     148
     14910 FORMAT (2X, 5('*'), '    Cycle_diurne = ', L3, 4X, ', Soil_model = ', L3, &
     150    12X, 6('*'))
     151
     152
     15311 FORMAT (2X, 5('*'), '  new_oliq = ', L3, 3X, ', Ok_orodr = ', L3, 3X, &
     154    ', Ok_orolf = ', L3, 3X, 5('*'))
     155
     156
     15712 FORMAT (2X, '*****  Nb d appels /jour des routines de rayonn. = ', I4, 6X, &
     158    ' *****')
     159
     16013 FORMAT (2X, '$$$$$$$$   Attention !!  cycle_diurne  different  sur', /1X, &
     161    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
     162
     16314 FORMAT (2X, '$$$$$$$$   Attention !!    soil_model  different  sur', /1X, &
     164    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
     165
     16615 FORMAT (2X, '$$$$$$$$   Attention !!      ok_orodr  different  sur', /1X, &
     167    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
     168
     16916 FORMAT (2X, '$$$$$$$$   Attention !!      new_oliq  different  sur', /1X, &
     170    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
     171
     17217 FORMAT (2X, '$$$$$$$$   Attention !!      ok_orolf  different  sur', /1X, &
     173    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
     174
     17518 FORMAT (2X, '$$$$$$$$   Attention !!  ok_limitvrai  different  sur', /1X, &
     176    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
     177
     17820 FORMAT (/2X, '$$$$$$$$   Attention !!    iflag_con  different  sur', /1X, &
     179    10X, ' startphy = ', I3, 2X, ' et  run.def = ', I3)
     180
     18121 FORMAT (2X, '$$$$$$$$   Attention !!     nbapp_rad  different  sur', /1X, &
     182    10X, ' startphy = ', I3, 2X, ' et  run.def = ', I3)
     183
     18422 FORMAT (2X, '$$$$$$$$   Attention !!        radpas  different  sur', /1X, &
     185    10X, ' startphy = ', I3, 2X, ' et  run.def = ', I3)
     186
     187100 FORMAT (/)
     188
     189  RETURN
     190END SUBROUTINE printflag
Note: See TracChangeset for help on using the changeset viewer.