source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/replay1d.F90 @ 5233

Last change on this file since 5233 was 4727, checked in by idelkadi, 13 months ago

Merged trunk changes -r4488:4726 LMDZ_ECRad branch

File size: 4.4 KB
Line 
1PROGRAM rejouer
2
3USE mod_const_mpi, ONLY: comm_lmdz
4USE inigeomphy_mod, ONLY: inigeomphy
5USE comvert_mod, ONLY: presnivs
6USE comvert_mod, only :  preff, pa
7USE ioipsl, only: getin
8
9
10
11
12      implicit none
13      INCLUDE "dimensions.h"
14
15real :: airefi
16real :: zcufi    = 1.
17real :: zcvfi    = 1.
18real :: rlat_rad(1),rlon_rad(1)
19
20integer ntime
21integer jour0,mois0,an0,day_step,anneeref,dayref
22integer klev,klon
23CHARACTER (len=10) :: calend
24CHARACTER(len=20) :: calendrier
25
26
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.
35
36preff=101325.
37!preff=100000.
38pa=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
48CALL suphel
49!ntime=4320
50ntime=10000000
51dayref=1
52anneeref=2000
53call getin('dayref',dayref)
54call getin('anneeref',anneeref)
55call getin('calend',calend)
56call getin('day_step',day_step)
57calendrier=calend
58if ( calendrier == "earth_360d" ) calendrier="360_day"
59
60
61jour0=dayref
62mois0=(jour0-1)/30+1
63jour0=jour0-30*((jour0-1)/30)
64an0=anneeref
65
66!print*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0
67
68
69klon=1
70klev=llm
71call 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!---------------------------------------------------------------------
77call call_ini_replay
78
79!---------------------------------------------------------------------
80! Boucle en temps sur l'appel à la parametrisation
81!---------------------------------------------------------------------
82call call_param_replay(klon,klev)
83
84end
85
86!---------------------------------------------------------------------
87!/////////////////////////////////////////////////////////////////////
88!/////////////////////////////////////////////////////////////////////
89!     routine additionnelles utiles, prises dans 1DUTILS.h
90!/////////////////////////////////////////////////////////////////////
91!/////////////////////////////////////////////////////////////////////
92!---------------------------------------------------------------------
93
94!=======================================================================
95      SUBROUTINE abort_gcm(modname, message, ierr)
96      USE IOIPSL
97! Stops the simulation cleanly, closing files and printing various
98! comments
99!=======================================================================
100!
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
115!
116      if (ierr .eq. 0) then
117        write(*,*) 'Everything is cool'
118      else
119        write(*,*) 'Houston, we have a problem ', ierr
120      endif
121      STOP
122      END
123
124!=======================================================================
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.NE.2+(jm-2)*(im-1).AND.ngrid.NE.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
Note: See TracBrowser for help on using the repository browser.