Ignore:
Timestamp:
Jul 24, 2024, 6:46:45 PM (6 months ago)
Author:
abarral
Message:

enforce PRIVATE by default in several modules, expose PUBLIC as needed
move eigen.f90 to obsolete/
(lint) aslong the way

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

    r5117 r5119  
    978978    ENDDO
    979979
    980 
    981980  END SUBROUTINE dyn1dredem
    982981
    983982
    984983  SUBROUTINE gr_fi_dyn(nfield, ngrid, im, jm, pfi, pdyn)
     984    USE lmdz_ssum_scopy, ONLY: scopy
     985
    985986    IMPLICIT NONE
    986987    !=======================================================================
     
    10161017      ENDDO
    10171018    ENDDO
    1018 
    10191019
    10201020  END SUBROUTINE gr_fi_dyn
     
    14691469    print *, 't_targ', t_targ
    14701470    print *, 'rh_targ', rh_targ
    1471 
    14721471
    14731472  END SUBROUTINE nudge_rht_init
  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

    r5117 r5119  
    561561    WRITE(*, *) ' '
    562562
    563   end
     563  END
    564564  SUBROUTINE mesolupbis(file_forctl)
    565565    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     
    773773
    774774    RETURN
    775   end
     775  END
    776776  SUBROUTINE GETSCH(STR, DEL, TRM, NTH, SST, NCH)
    777777    !***************************************************************
  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h

    r5117 r5119  
    138138
    139139          RETURN
    140           end
     140          END
    141141!=====================================================================
    142142      subroutine read_twpice(fich_twpice,nlevel,ntime                       &
     
    534534
    535535       RETURN
    536        end
     536       END
    537537!=====================================================================
    538538
     
    647647
    648648          RETURN
    649           end
     649          END
    650650!=====================================================================
    651651       SUBROUTINE interp_astex_vertical(play,nlev_astex,plev_prof          &
     
    11601160 
    11611161          RETURN
    1162           end
     1162          END
    11631163 
    11641164!=====================================================================
     
    13191319 
    13201320          RETURN
    1321           end
     1321          END
    13221322!*****************************************************************************
    13231323!=====================================================================
     
    20292029
    20302030        RETURN
    2031         end
     2031        END
    20322032!======================================================================
    20332033      subroutine readprofile_sandu(nlev_max,kmax,height,pprof,tprof,       &
  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90

    r5117 r5119  
    11PROGRAM rejouer
    22
    3 USE mod_const_mpi, ONLY: comm_lmdz
    4 USE inigeomphy_mod, ONLY: inigeomphy
    5 USE comvert_mod, ONLY: presnivs
    6 USE comvert_mod, ONLY:  preff, pa
    7 USE ioipsl, ONLY: getin
     3  USE mod_const_mpi, ONLY: comm_lmdz
     4  USE inigeomphy_mod, ONLY: inigeomphy
     5  USE comvert_mod, ONLY: presnivs
     6  USE comvert_mod, ONLY: preff, pa
     7  USE ioipsl, ONLY: getin
     8
     9  IMPLICIT NONE
     10  INCLUDE "dimensions.h"
     11
     12  REAL :: airefi
     13  REAL :: zcufi = 1.
     14  REAL :: zcvfi = 1.
     15  REAL :: rlat_rad(1), rlon_rad(1)
     16
     17  INTEGER ntime
     18  INTEGER jour0, mois0, an0, day_step, anneeref, dayref
     19  INTEGER klev, klon
     20  CHARACTER (len = 10) :: calend
     21  CHARACTER(len = 20) :: calendrier
    822
    923
     24  !---------------------------------------------------------------------
     25  ! L'appel a inigeomphy n'est utile que pour avoir getin_p dans
     26  ! les initialisations
     27  !---------------------------------------------------------------------
     28  zcufi = 1.
     29  zcvfi = 1.
     30  rlat_rad(1) = 0.
     31  rlon_rad(1) = 0.
    1032
     33  preff = 101325.
     34  !preff=100000.
     35  pa = 50000.
     36  CALL disvert()
     37  CALL inigeomphy(1, 1, llm, &
     38          1, comm_lmdz, &
     39          (/rlat_rad(1), 0./), (/0./), &
     40          (/0., 0./), (/rlon_rad(1), 0./), &
     41          (/ (/airefi, 0./), (/0., 0./) /), &
     42          (/zcufi, 0., 0., 0./), &
     43          (/zcvfi, 0./))
    1144
    12       IMPLICIT NONE
    13       INCLUDE "dimensions.h"
     45  CALL suphel
     46  !ntime=4320
     47  ntime = 10000000
     48  dayref = 1
     49  anneeref = 2000
     50  CALL getin('dayref', dayref)
     51  CALL getin('anneeref', anneeref)
     52  CALL getin('calend', calend)
     53  CALL getin('day_step', day_step)
     54  calendrier = calend
     55  IF (calendrier == "earth_360d") calendrier = "360_day"
    1456
    15 REAL :: airefi
    16 REAL :: zcufi    = 1.
    17 REAL :: zcvfi    = 1.
    18 REAL :: rlat_rad(1),rlon_rad(1)
     57  jour0 = dayref
     58  mois0 = (jour0 - 1) / 30 + 1
     59  jour0 = jour0 - 30 * ((jour0 - 1) / 30)
     60  an0 = anneeref
    1961
    20 INTEGER ntime
    21 INTEGER jour0,mois0,an0,day_step,anneeref,dayref
    22 INTEGER klev,klon
    23 CHARACTER (len=10) :: calend
    24 CHARACTER(len=20) :: calendrier
     62  !PRINT*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0
    2563
     64  klon = 1
     65  klev = llm
     66  CALL iotd_ini('phys.nc', 1, 1, klev, 0., 0., presnivs, jour0, mois0, an0, 0., 86400. / day_step, calendrier)
     67  ! Consistent with ... CALL iophys_ini(600.)
    2668
    27 !---------------------------------------------------------------------
    28 ! L'appel a inigeomphy n'est utile que pour avoir getin_p dans
    29 ! les initialisations
    30 !---------------------------------------------------------------------
    31   zcufi=1.
    32   zcvfi=1.
    33   rlat_rad(1)=0.
    34   rlon_rad(1)=0.
     69  !---------------------------------------------------------------------
     70  ! Initialisation de la parametrisation
     71  !---------------------------------------------------------------------
     72  CALL call_ini_replay
    3573
    36 preff=101325.
    37 !preff=100000.
    38 pa=50000.
    39   CALL disvert()
    40   CALL inigeomphy(1,1,llm, &
    41                1, comm_lmdz, &
    42            (/rlat_rad(1),0./),(/0./), &
    43            (/0.,0./),(/rlon_rad(1),0./),  &
    44            (/ (/airefi,0./),(/0.,0./) /), &
    45            (/zcufi,0.,0.,0./), &
    46            (/zcvfi,0./))
    47 
    48 CALL suphel
    49 !ntime=4320
    50 ntime=10000000
    51 dayref=1
    52 anneeref=2000
    53 CALL getin('dayref',dayref)
    54 CALL getin('anneeref',anneeref)
    55 CALL getin('calend',calend)
    56 CALL getin('day_step',day_step)
    57 calendrier=calend
    58 IF ( calendrier == "earth_360d" ) calendrier="360_day"
    59 
    60 
    61 jour0=dayref
    62 mois0=(jour0-1)/30+1
    63 jour0=jour0-30*((jour0-1)/30)
    64 an0=anneeref
    65 
    66 !PRINT*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0
    67 
    68 
    69 klon=1
    70 klev=llm
    71 CALL iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier)
    72 ! Consistent with ... CALL iophys_ini(600.)
    73 
    74 !---------------------------------------------------------------------
    75 ! Initialisation de la parametrisation
    76 !---------------------------------------------------------------------
    77 CALL call_ini_replay
    78 
    79 !---------------------------------------------------------------------
    80 ! Boucle en temps sur l'appel à la parametrisation
    81 !---------------------------------------------------------------------
    82 CALL call_param_replay(klon,klev)
     74  !---------------------------------------------------------------------
     75  ! Boucle en temps sur l'appel à la parametrisation
     76  !---------------------------------------------------------------------
     77  CALL call_param_replay(klon, klev)
    8378
    8479end
     
    9388
    9489!=======================================================================
    95       SUBROUTINE abort_gcm(modname, message, ierr)
    96       USE IOIPSL
    97 ! Stops the simulation cleanly, closing files and printing various
    98 ! comments
    99 !=======================================================================
     90SUBROUTINE abort_gcm(modname, message, ierr)
     91  USE IOIPSL
     92  ! Stops the simulation cleanly, closing files and printing various
     93  ! comments
     94  !=======================================================================
    10095
    101 !  Input: modname = name of calling program
    102 !         message = stuff to print
    103 !         ierr    = severity of situation ( = 0 normal )
    104  
    105       CHARACTER(LEN=*) modname
    106       INTEGER ierr
    107       CHARACTER(LEN=*) message
    108  
    109       WRITE(*,*) 'in abort_gcm'
    110       CALL histclo
    111       WRITE(*,*) 'out of histclo'
    112       WRITE(*,*) 'Stopping in ', modname
    113       WRITE(*,*) 'Reason = ',message
    114       CALL getin_dump
     96  !  Input: modname = name of calling program
     97  !         message = stuff to print
     98  !         ierr    = severity of situation ( = 0 normal )
    11599
    116       IF (ierr == 0) THEN
    117         WRITE(*,*) 'Everything is cool'
    118       else
    119         WRITE(*,*) 'Houston, we have a problem ', ierr
    120       endif
    121       STOP
    122       END
     100  CHARACTER(LEN = *) modname
     101  INTEGER ierr
     102  CHARACTER(LEN = *) message
     103
     104  WRITE(*, *) 'in abort_gcm'
     105  CALL histclo
     106  WRITE(*, *) 'out of histclo'
     107  WRITE(*, *) 'Stopping in ', modname
     108  WRITE(*, *) 'Reason = ', message
     109  CALL getin_dump
     110
     111  IF (ierr == 0) THEN
     112    WRITE(*, *) 'Everything is cool'
     113  else
     114    WRITE(*, *) 'Houston, we have a problem ', ierr
     115  endif
     116  STOP
     117END
    123118
    124119!=======================================================================
    125       SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
    126       IMPLICIT NONE
    127 !   passage d'un champ de la grille scalaire a la grille physique
    128 !=======================================================================
    129  
    130 !-----------------------------------------------------------------------
    131 !   declarations:
    132 !   -------------
    133  
    134       INTEGER im,jm,ngrid,nfield
    135       REAL pdyn(im,jm,nfield)
    136       REAL pfi(ngrid,nfield)
    137  
    138       INTEGER j,ifield,ig
    139  
    140 !-----------------------------------------------------------------------
    141 !   calcul:
    142 !   -------
    143  
    144       IF(ngrid/=2+(jm-2)*(im-1).AND.ngrid/=1)                          &
    145       STOP 'probleme de dim'
    146 !   traitement des poles
    147       CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
    148       CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
    149  
    150 !   traitement des point normaux
    151       DO ifield=1,nfield
    152          DO j=2,jm-1
    153             ig=2+(j-2)*(im-1)
    154             CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
    155          ENDDO
    156       ENDDO
    157  
    158       RETURN
    159       END
     120SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi)
     121  USE lmdz_ssum_scopy, ONLY: scopy
     122
     123  IMPLICIT NONE
     124  !   passage d'un champ de la grille scalaire a la grille physique
     125  !=======================================================================
     126
     127  !-----------------------------------------------------------------------
     128  !   declarations:
     129  !   -------------
     130
     131  INTEGER im, jm, ngrid, nfield
     132  REAL pdyn(im, jm, nfield)
     133  REAL pfi(ngrid, nfield)
     134
     135  INTEGER j, ifield, ig
     136
     137  !-----------------------------------------------------------------------
     138  !   calcul:
     139  !   -------
     140
     141  IF(ngrid/=2 + (jm - 2) * (im - 1).AND.ngrid/=1)                          &
     142          STOP 'probleme de dim'
     143  !   traitement des poles
     144  CALL SCOPY(nfield, pdyn, im * jm, pfi, ngrid)
     145  CALL SCOPY(nfield, pdyn(1, jm, 1), im * jm, pfi(ngrid, 1), ngrid)
     146
     147  !   traitement des point normaux
     148  DO ifield = 1, nfield
     149    DO j = 2, jm - 1
     150      ig = 2 + (j - 2) * (im - 1)
     151      CALL SCOPY(im - 1, pdyn(1, j, ifield), 1, pfi(ig, ifield), 1)
     152    ENDDO
     153  ENDDO
     154
     155  RETURN
     156END
Note: See TracChangeset for help on using the changeset viewer.