source: LMDZ6/branches/Amaury_dev/libf/phylmd/interfoce_lim.F90 @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 4 months ago

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.4 KB
Line 
1
2! $Header$
3
4SUBROUTINE interfoce_lim(itime, dtime, jour, &
5     knon, knindex, &
6     debut,  &
7     lmt_sst_p, pctsrf_new_p)
8 
9  USE mod_grid_phy_lmdz
10  USE mod_phys_lmdz_para
11  USE indice_sol_mod
12  USE netcdf, ONLY: nf90_get_var,nf90_close,nf90_noerr,nf90_inq_varid,nf90_open,nf90_nowrite
13 
14  IMPLICIT NONE
15
16! Cette routine sert d'interface entre le modele atmospherique et un fichier
17! de conditions aux limites
18
19! L. Fairhead 02/2000
20
21! input:
22!   itime        numero du pas de temps courant
23!   dtime        pas de temps de la physique (en s)
24!   jour         jour a lire dans l'annee
25!   nisurf       index de la surface a traiter (1 = sol continental)
26!   knon         nombre de points dans le domaine a traiter
27!   knindex      index des points de la surface a traiter
28!   klon         taille de la grille
29!   debut        logical: 1er appel a la physique (initialisation)
30
31! output:
32!   lmt_sst_p      SST lues dans le fichier de CL
33!   pctsrf_new-p   sous-maille fractionnelle
34
35! Parametres d'entree
36!****************************************************************************************
37  INTEGER, INTENT(IN)                       :: itime
38  INTEGER, INTENT(IN)                       :: jour
39  INTEGER, INTENT(IN)                       :: knon
40  INTEGER, DIMENSION(klon_loc), INTENT(IN)  :: knindex
41  REAL   , INTENT(IN)                       :: dtime
42  LOGICAL, INTENT(IN)                       :: debut
43 
44! Parametres de sortie
45!****************************************************************************************
46  REAL, INTENT(OUT), DIMENSION(klon_loc)       :: lmt_sst_p
47  REAL, INTENT(OUT), DIMENSION(klon_loc,nbsrf) :: pctsrf_new_p
48
49
50! Variables locales avec l'attribut SAVE
51!****************************************************************************************
52! frequence de lecture des conditions limites (en pas de physique)
53  INTEGER,SAVE                              :: lmt_pas   
54  !$OMP THREADPRIVATE(lmt_pas)
55! pour indiquer que le jour a lire est deja lu pour une surface precedente
56  LOGICAL,SAVE                              :: deja_lu   
57  !$OMP THREADPRIVATE(deja_lu)
58  INTEGER,SAVE                              :: jour_lu
59  !$OMP THREADPRIVATE(jour_lu)
60  CHARACTER (len = 20),SAVE                 :: fich ='limit.nc'
61  !$OMP THREADPRIVATE(fich)
62  LOGICAL, SAVE                             :: newlmt = .TRUE.
63  !$OMP THREADPRIVATE(newlmt)
64  LOGICAL, SAVE                             :: check = .FALSE.
65  !$OMP THREADPRIVATE(check)
66  REAL, ALLOCATABLE , SAVE, DIMENSION(:)    :: sst_lu_p
67  !$OMP THREADPRIVATE(sst_lu_p)
68  REAL, ALLOCATABLE , SAVE, DIMENSION(:,:)  :: pct_tmp_p
69  !$OMP THREADPRIVATE(pct_tmp_p)
70
71! Variables locales
72!****************************************************************************************
73  INTEGER                                   :: nid, nvarid
74  INTEGER                                   :: ii
75  INTEGER                                   :: ierr
76  INTEGER, DIMENSION(2)                     :: start, epais
77  CHARACTER (len = 20)                      :: modname = 'interfoce_lim'
78  CHARACTER (len = 80)                      :: abort_message
79  REAL, DIMENSION(klon_glo,nbsrf)           :: pctsrf_new
80  REAL, DIMENSION(klon_glo,nbsrf)           :: pct_tmp
81  REAL, DIMENSION(klon_glo)                 :: sst_lu
82  REAL, DIMENSION(klon_glo)                 :: nat_lu
83
84! Fin declaration
85!****************************************************************************************
86
87!****************************************************************************************
88! Start calculation
89
90!****************************************************************************************
91  IF (debut .AND. .NOT. ALLOCATED(sst_lu_p)) THEN
92     lmt_pas = NINT(86400./dtime * 1.0) ! pour une lecture une fois par jour
93     jour_lu = jour - 1
94     ALLOCATE(sst_lu_p(klon_loc))
95     ALLOCATE(pct_tmp_p(klon_loc,nbsrf))
96  ENDIF
97 
98  IF ((jour - jour_lu) /= 0) deja_lu = .FALSE.
99 
100  IF (check) WRITE(*,*) modname, ' :: jour, jour_lu, deja_lu', jour, jour_lu, deja_lu
101  IF (check) WRITE(*,*) modname, ' :: itime, lmt_pas ', itime, lmt_pas,dtime
102
103!****************************************************************************************
104! Ouverture et lecture du fichier pour le master process si c'est le bon moment
105
106!****************************************************************************************
107! Tester d'abord si c'est le moment de lire le fichier
108  IF (MOD(itime-1, lmt_pas) == 0 .AND. .NOT. deja_lu) THEN
109
110!$OMP MASTER
111     IF (is_mpi_root) THEN
112
113        fich = TRIM(fich)
114        ierr = nf90_open (fich, nf90_nowrite,nid)
115        IF (ierr/=nf90_noerr) THEN
116           abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
117           CALL abort_physic(modname,abort_message,1)
118        ENDIF
119
120        ! La tranche de donnees a lire:
121
122        start(1) = 1
123        start(2) = jour
124        epais(1) = klon_glo
125        epais(2) = 1
126
127        IF (newlmt) THEN
128
129           ! Fraction "ocean"
130
131           ierr = nf90_inq_varid(nid, 'FOCE', nvarid)
132           IF (ierr /= nf90_noerr) THEN
133              abort_message = 'Le champ <FOCE> est absent'
134              CALL abort_physic(modname,abort_message,1)
135           ENDIF
136           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_oce),start,epais)
137           IF (ierr /= nf90_noerr) THEN
138              abort_message = 'Lecture echouee pour <FOCE>'
139              CALL abort_physic(modname,abort_message,1)
140           ENDIF
141
142           ! Fraction "glace de mer"
143
144           ierr = nf90_inq_varid(nid, 'FSIC', nvarid)
145           IF (ierr /= nf90_noerr) THEN
146              abort_message = 'Le champ <FSIC> est absent'
147              CALL abort_physic(modname,abort_message,1)
148           ENDIF
149           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_sic),start,epais)
150           IF (ierr /= nf90_noerr) THEN
151              abort_message = 'Lecture echouee pour <FSIC>'
152              CALL abort_physic(modname,abort_message,1)
153           ENDIF
154
155           ! Fraction "terre"
156
157           ierr = nf90_inq_varid(nid, 'FTER', nvarid)
158           IF (ierr /= nf90_noerr) THEN
159              abort_message = 'Le champ <FTER> est absent'
160              CALL abort_physic(modname,abort_message,1)
161           ENDIF
162           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_ter),start,epais)
163           IF (ierr /= nf90_noerr) THEN
164              abort_message = 'Lecture echouee pour <FTER>'
165              CALL abort_physic(modname,abort_message,1)
166           ENDIF
167
168           ! Fraction "glacier terre"
169
170           ierr = nf90_inq_varid(nid, 'FLIC', nvarid)
171           IF (ierr /= nf90_noerr) THEN
172              abort_message = 'Le champ <FLIC> est absent'
173              CALL abort_physic(modname,abort_message,1)
174           ENDIF
175           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_lic),start,epais)
176           IF (ierr /= nf90_noerr) THEN
177              abort_message = 'Lecture echouee pour <FLIC>'
178              CALL abort_physic(modname,abort_message,1)
179           ENDIF
180
181        ELSE  ! on en est toujours a rnatur
182
183           ierr = nf90_inq_varid(nid, 'NAT', nvarid)
184           IF (ierr /= nf90_noerr) THEN
185              abort_message = 'Le champ <NAT> est absent'
186              CALL abort_physic(modname,abort_message,1)
187           ENDIF
188           ierr = nf90_get_var(nid,nvarid,nat_lu,start,epais)
189           IF (ierr /= nf90_noerr) THEN
190              abort_message = 'Lecture echouee pour <NAT>'
191              CALL abort_physic(modname,abort_message,1)
192           ENDIF
193
194! Remplissage des fractions de surface
195! nat = 0, 1, 2, 3 pour ocean, terre, glacier, seaice
196
197           pct_tmp = 0.0
198           DO ii = 1, klon_glo
199              pct_tmp(ii,NINT(nat_lu(ii)) + 1) = 1.
200           ENDDO
201
202!  On se retrouve avec ocean en 1 et terre en 2 alors qu'on veut le contraire
203
204           pctsrf_new = pct_tmp
205           pctsrf_new (:,2)= pct_tmp (:,1)
206           pctsrf_new (:,1)= pct_tmp (:,2)
207           pct_tmp = pctsrf_new
208        ENDIF ! fin test sur newlmt
209
210! Lecture SST
211
212        ierr = nf90_inq_varid(nid, 'SST', nvarid)
213        IF (ierr /= nf90_noerr) THEN
214           abort_message = 'Le champ <SST> est absent'
215           CALL abort_physic(modname,abort_message,1)
216        ENDIF
217        ierr = nf90_get_var(nid,nvarid,sst_lu,start,epais)
218        IF (ierr /= nf90_noerr) THEN
219           abort_message = 'Lecture echouee pour <SST>'
220           CALL abort_physic(modname,abort_message,1)
221        ENDIF
222         
223!****************************************************************************************
224! Fin de lecture, fermeture de fichier
225
226!****************************************************************************************
227        ierr = nf90_close(nid)
228     ENDIF ! is_mpi_root
229
230!$OMP END MASTER
231!$OMP BARRIER
232
233
234!****************************************************************************************
235! Distribue les variables sur tous les processus
236
237!****************************************************************************************
238     CALL Scatter(sst_lu,sst_lu_p)
239     CALL Scatter(pct_tmp(:,is_oce),pct_tmp_p(:,is_oce))
240     CALL Scatter(pct_tmp(:,is_sic),pct_tmp_p(:,is_sic))
241     deja_lu = .TRUE.
242     jour_lu = jour
243  ENDIF
244
245!****************************************************************************************
246! Recopie des variables dans les champs de sortie
247
248!****************************************************************************************
249  lmt_sst_p = 999999999.
250 
251  DO ii = 1, knon
252     lmt_sst_p(ii) = sst_lu_p(knindex(ii))
253  ENDDO
254 
255  DO ii=1,klon_loc
256     pctsrf_new_p(ii,is_oce)=pct_tmp_p(ii,is_oce)
257     pctsrf_new_p(ii,is_sic)=pct_tmp_p(ii,is_sic)
258  ENDDO
259 
260 
261END SUBROUTINE interfoce_lim
Note: See TracBrowser for help on using the repository browser.