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

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

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