source: LMDZ6/trunk/libf/phylmd/interfoce_lim.f90 @ 5831

Last change on this file since 5831 was 5270, checked in by abarral, 13 months ago

Replace F77 netcdf library by F90 netcdf library
  • 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.6 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
36
37! Parametres d'entree
38!****************************************************************************************
39  INTEGER, INTENT(IN)                       :: itime
40  INTEGER, INTENT(IN)                       :: jour
41  INTEGER, INTENT(IN)                       :: knon
42  INTEGER, DIMENSION(klon_loc), INTENT(IN)  :: knindex
43  REAL   , INTENT(IN)                       :: dtime
44  LOGICAL, INTENT(IN)                       :: debut
45 
46! Parametres de sortie
47!****************************************************************************************
48  REAL, INTENT(OUT), DIMENSION(klon_loc)       :: lmt_sst_p
49  REAL, INTENT(OUT), DIMENSION(klon_loc,nbsrf) :: pctsrf_new_p
50
51
52! Variables locales avec l'attribut SAVE
53!****************************************************************************************
54! frequence de lecture des conditions limites (en pas de physique)
55  INTEGER,SAVE                              :: lmt_pas   
56  !$OMP THREADPRIVATE(lmt_pas)
57! pour indiquer que le jour a lire est deja lu pour une surface precedente
58  LOGICAL,SAVE                              :: deja_lu   
59  !$OMP THREADPRIVATE(deja_lu)
60  INTEGER,SAVE                              :: jour_lu
61  !$OMP THREADPRIVATE(jour_lu)
62  CHARACTER (len = 20),SAVE                 :: fich ='limit.nc'
63  !$OMP THREADPRIVATE(fich)
64  LOGICAL, SAVE                             :: newlmt = .TRUE.
65  !$OMP THREADPRIVATE(newlmt)
66  LOGICAL, SAVE                             :: check = .FALSE.
67  !$OMP THREADPRIVATE(check)
68  REAL, ALLOCATABLE , SAVE, DIMENSION(:)    :: sst_lu_p
69  !$OMP THREADPRIVATE(sst_lu_p)
70  REAL, ALLOCATABLE , SAVE, DIMENSION(:,:)  :: pct_tmp_p
71  !$OMP THREADPRIVATE(pct_tmp_p)
72
73! Variables locales
74!****************************************************************************************
75  INTEGER                                   :: nid, nvarid
76  INTEGER                                   :: ii
77  INTEGER                                   :: ierr
78  INTEGER, DIMENSION(2)                     :: start, epais
79  CHARACTER (len = 20)                      :: modname = 'interfoce_lim'
80  CHARACTER (len = 80)                      :: abort_message
81  REAL, DIMENSION(klon_glo,nbsrf)           :: pctsrf_new
82  REAL, DIMENSION(klon_glo,nbsrf)           :: pct_tmp
83  REAL, DIMENSION(klon_glo)                 :: sst_lu
84  REAL, DIMENSION(klon_glo)                 :: nat_lu
85!
86! Fin declaration
87!****************************************************************************************
88
89!****************************************************************************************
90! Start calculation
91!
92!****************************************************************************************
93  IF (debut .AND. .NOT. ALLOCATED(sst_lu_p)) THEN
94     lmt_pas = NINT(86400./dtime * 1.0) ! pour une lecture une fois par jour
95     jour_lu = jour - 1
96     ALLOCATE(sst_lu_p(klon_loc))
97     ALLOCATE(pct_tmp_p(klon_loc,nbsrf))
98  ENDIF
99 
100  IF ((jour - jour_lu) /= 0) deja_lu = .FALSE.
101 
102  IF (check) WRITE(*,*) modname, ' :: jour, jour_lu, deja_lu', jour, jour_lu, deja_lu
103  IF (check) WRITE(*,*) modname, ' :: itime, lmt_pas ', itime, lmt_pas,dtime
104
105!****************************************************************************************
106! Ouverture et lecture du fichier pour le master process si c'est le bon moment
107!
108!****************************************************************************************
109! Tester d'abord si c'est le moment de lire le fichier
110  IF (MOD(itime-1, lmt_pas) == 0 .AND. .NOT. deja_lu) THEN
111
112!$OMP MASTER
113     IF (is_mpi_root) THEN
114
115        fich = TRIM(fich)
116        ierr = nf90_open (fich, nf90_nowrite,nid)
117        IF (ierr.NE.nf90_noerr) THEN
118           abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
119           CALL abort_physic(modname,abort_message,1)
120        ENDIF
121
122        ! La tranche de donnees a lire:
123
124        start(1) = 1
125        start(2) = jour
126        epais(1) = klon_glo
127        epais(2) = 1
128
129        IF (newlmt) THEN
130           !
131           ! Fraction "ocean"
132           !
133           ierr = nf90_inq_varid(nid, 'FOCE', nvarid)
134           IF (ierr /= nf90_noerr) THEN
135              abort_message = 'Le champ <FOCE> est absent'
136              CALL abort_physic(modname,abort_message,1)
137           ENDIF
138           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_oce),start,epais)
139           IF (ierr /= nf90_noerr) THEN
140              abort_message = 'Lecture echouee pour <FOCE>'
141              CALL abort_physic(modname,abort_message,1)
142           ENDIF
143           !
144           ! Fraction "glace de mer"
145           !
146           ierr = nf90_inq_varid(nid, 'FSIC', nvarid)
147           IF (ierr /= nf90_noerr) THEN
148              abort_message = 'Le champ <FSIC> est absent'
149              CALL abort_physic(modname,abort_message,1)
150           ENDIF
151           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_sic),start,epais)
152           IF (ierr /= nf90_noerr) THEN
153              abort_message = 'Lecture echouee pour <FSIC>'
154              CALL abort_physic(modname,abort_message,1)
155           ENDIF
156           !
157           ! Fraction "terre"
158           !
159           ierr = nf90_inq_varid(nid, 'FTER', nvarid)
160           IF (ierr /= nf90_noerr) THEN
161              abort_message = 'Le champ <FTER> est absent'
162              CALL abort_physic(modname,abort_message,1)
163           ENDIF
164           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_ter),start,epais)
165           IF (ierr /= nf90_noerr) THEN
166              abort_message = 'Lecture echouee pour <FTER>'
167              CALL abort_physic(modname,abort_message,1)
168           ENDIF
169           !
170           ! Fraction "glacier terre"
171           !
172           ierr = nf90_inq_varid(nid, 'FLIC', nvarid)
173           IF (ierr /= nf90_noerr) THEN
174              abort_message = 'Le champ <FLIC> est absent'
175              CALL abort_physic(modname,abort_message,1)
176           ENDIF
177           ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_lic),start,epais)
178           IF (ierr /= nf90_noerr) THEN
179              abort_message = 'Lecture echouee pour <FLIC>'
180              CALL abort_physic(modname,abort_message,1)
181           ENDIF
182           !
183        ELSE  ! on en est toujours a rnatur
184           !
185           ierr = nf90_inq_varid(nid, 'NAT', nvarid)
186           IF (ierr /= nf90_noerr) THEN
187              abort_message = 'Le champ <NAT> est absent'
188              CALL abort_physic(modname,abort_message,1)
189           ENDIF
190           ierr = nf90_get_var(nid,nvarid,nat_lu,start,epais)
191           IF (ierr /= nf90_noerr) THEN
192              abort_message = 'Lecture echouee pour <NAT>'
193              CALL abort_physic(modname,abort_message,1)
194           ENDIF
195!
196! Remplissage des fractions de surface
197! nat = 0, 1, 2, 3 pour ocean, terre, glacier, seaice
198!
199           pct_tmp = 0.0
200           DO ii = 1, klon_glo
201              pct_tmp(ii,NINT(nat_lu(ii)) + 1) = 1.
202           ENDDO
203
204!
205!  On se retrouve avec ocean en 1 et terre en 2 alors qu'on veut le contraire
206!
207           pctsrf_new = pct_tmp
208           pctsrf_new (:,2)= pct_tmp (:,1)
209           pctsrf_new (:,1)= pct_tmp (:,2)
210           pct_tmp = pctsrf_new
211        ENDIF ! fin test sur newlmt
212!
213! Lecture SST
214!
215        ierr = nf90_inq_varid(nid, 'SST', nvarid)
216        IF (ierr /= nf90_noerr) THEN
217           abort_message = 'Le champ <SST> est absent'
218           CALL abort_physic(modname,abort_message,1)
219        ENDIF
220        ierr = nf90_get_var(nid,nvarid,sst_lu,start,epais)
221        IF (ierr /= nf90_noerr) THEN
222           abort_message = 'Lecture echouee pour <SST>'
223           CALL abort_physic(modname,abort_message,1)
224        ENDIF
225         
226!****************************************************************************************
227! Fin de lecture, fermeture de fichier
228!
229!****************************************************************************************
230        ierr = nf90_close(nid)
231     ENDIF ! is_mpi_root
232
233!$OMP END MASTER
234!$OMP BARRIER
235
236
237!****************************************************************************************
238! Distribue les variables sur tous les processus
239!
240!****************************************************************************************
241     CALL Scatter(sst_lu,sst_lu_p)
242     CALL Scatter(pct_tmp(:,is_oce),pct_tmp_p(:,is_oce))
243     CALL Scatter(pct_tmp(:,is_sic),pct_tmp_p(:,is_sic))
244     deja_lu = .TRUE.
245     jour_lu = jour
246  ENDIF
247
248!****************************************************************************************
249! Recopie des variables dans les champs de sortie
250!
251!****************************************************************************************
252  lmt_sst_p = 999999999.
253 
254  DO ii = 1, knon
255     lmt_sst_p(ii) = sst_lu_p(knindex(ii))
256  ENDDO
257 
258  DO ii=1,klon_loc
259     pctsrf_new_p(ii,is_oce)=pct_tmp_p(ii,is_oce)
260     pctsrf_new_p(ii,is_sic)=pct_tmp_p(ii,is_sic)
261  ENDDO
262 
263 
264END SUBROUTINE interfoce_lim
Note: See TracBrowser for help on using the repository browser.