source: LMDZ6/trunk/libf/phylmdiso/limit_read_mod.F90 @ 4087

Last change on this file since 4087 was 3927, checked in by Laurent Fairhead, 3 years ago

Initial import of the physics wih isotopes from Camille Risi
CR
File size: 22.3 KB
RevLine 
[3927]1!
2! $Id: limit_read_mod.F90 3435 2019-01-22 15:21:59Z fairhead $
3!
4MODULE limit_read_mod
5!
6! This module reads the fichier "limit.nc" containing fields for surface forcing.
7!
8! Module subroutines :
9!  limit_read_frac    : call limit_read_tot and return the fractions
10!  limit_read_rug_alb : return rugosity and albedo, if coupled ocean call limit_read_tot first
11!  limit_read_sst     : return sea ice temperature   
12!  limit_read_tot     : read limit.nc and store the fields in local modules variables
13!
14  IMPLICIT NONE
15
16  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE, PRIVATE :: pctsrf
17!$OMP THREADPRIVATE(pctsrf)
18  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: rugos
19!$OMP THREADPRIVATE(rugos)
20  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: albedo
21!$OMP THREADPRIVATE(albedo) 
22  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sst
23!$OMP THREADPRIVATE(sst)   
24#ifdef ISO
25  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: tuoce
26!$OMP THREADPRIVATE(tuoce)
27#endif
28  LOGICAL,SAVE :: read_continents=.FALSE.
29!$OMP THREADPRIVATE(read_continents)
30
31CONTAINS
32!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
33!!
34!! Public subroutines :
35!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
36
37
38  SUBROUTINE init_limit_read(first_day)
39  USE mod_grid_phy_lmdz
40  USE surface_data
41  USE mod_phys_lmdz_para
42#ifdef CPP_XIOS
43  USE XIOS
44#endif
45  IMPLICIT NONE
46    INTEGER, INTENT(IN) :: first_day
47   
48   
49    IF ( type_ocean /= 'couple') THEN
50      IF (grid_type==unstructured) THEN
51#ifdef CPP_XIOS
52        IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
53#endif
54      ENDIF 
55    ENDIF
56
57  END SUBROUTINE init_limit_read
58 
59  SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified)
60!
61! This subroutine is called from "change_srf_frac" for case of
62! ocean=force or from ocean_slab_frac for ocean=slab.
63! The fraction for all sub-surfaces at actual time step is returned.
64
65    USE dimphy
66    USE indice_sol_mod
67
68! Input arguments
69!****************************************************************************************
70    INTEGER, INTENT(IN) :: itime   ! time step
71    INTEGER, INTENT(IN) :: jour    ! current day
72    REAL   , INTENT(IN) :: dtime   ! length of time step
73 
74! Output arguments
75!****************************************************************************************
76    REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pctsrf_new  ! sub surface fractions
77    LOGICAL, INTENT(OUT)                     :: is_modified ! true if pctsrf is modified at this time step
78
79! End declaration
80!****************************************************************************************
81
82! 1) Read file limit.nc
83    CALL limit_read_tot(itime, dtime, jour, is_modified)
84
85! 2) Return the fraction read in limit_read_tot
86    pctsrf_new(:,:) = pctsrf(:,:)
87   
88  END SUBROUTINE limit_read_frac
89
90!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
91
92  SUBROUTINE limit_read_rug_alb(itime, dtime, jour, &
93       knon, knindex, &
94       rugos_out, alb_out)
95!
96! This subroutine is called from surf_land_bucket.
97! The flag "ok_veget" must can not be true. If coupled run, "ocean=couple"
98! then this routine will call limit_read_tot.
99!
100    USE dimphy
101    USE surface_data
102#ifdef ISO
103    USE isotopes_mod, ONLY: P_veg
104#endif
105
106! Input arguments
107!****************************************************************************************
108    INTEGER, INTENT(IN) :: itime                     ! numero du pas de temps courant
109    INTEGER, INTENT(IN) :: jour                      ! jour a lire dans l'annee
110    REAL   , INTENT(IN) :: dtime                     ! pas de temps de la physique (en s)
111    INTEGER, INTENT(IN) :: knon                      ! nomber of points on compressed grid
112    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
113! Output arguments
114!****************************************************************************************
115    REAL, DIMENSION(klon), INTENT(OUT) :: rugos_out
116    REAL, DIMENSION(klon), INTENT(OUT) :: alb_out
117   
118! Local variables
119!****************************************************************************************
120    INTEGER :: i
121    LOGICAL :: is_modified
122
123!****************************************************************************************
124
125IF (type_ocean == 'couple'.OR. &
126         (type_ocean == 'slab' .AND. version_ocean == 'sicINT')) THEN
127       ! limit.nc has not yet been read. Do it now!
128       CALL limit_read_tot(itime, dtime, jour, is_modified)
129    END IF
130
131    DO i=1,knon
132       rugos_out(i) = rugos(knindex(i))
133       alb_out(i)  = albedo(knindex(i))
134    END DO
135
136  END SUBROUTINE limit_read_rug_alb
137
138!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
139
140  SUBROUTINE limit_read_sst(knon, knindex, sst_out &
141#ifdef ISO
142     &  ,Roce,rlat   &
143#endif           
144    )
145!
146! This subroutine returns the sea surface temperature already read from limit.nc.
147!
148    USE dimphy, ONLY : klon
149#ifdef ISO
150    USE infotrac_phy, ONLY: niso
151    USE isotopes_mod, ONLY: tcorr,toce,modif_sst, &
152   &    deltaTtest,sstlatcrit,deltaTtestpoles,dsstlatcrit, &
153   &    iso_HTO,ok_prod_nucl_tritium
154#ifdef ISOVERIF
155    USE isotopes_verif_mod, ONLY: iso_verif_egalite_vect2D,iso_verif_positif, &
156        iso_verif_positif_nostop
157#endif
158#endif
159
160    INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
161    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
162    REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out
163#ifdef ISO
164    REAL, DIMENSION(klon) :: tuoce_out ! sortie tritium surface ocean
165#endif
166
167    INTEGER :: i
168#ifdef ISO
169  real, intent(out), dimension(niso,klon) :: Roce
170  integer :: ixt 
171  real, intent(in),dimension(klon) :: rlat
172  real lat_locale
173#endif
174!#ifdef ISOVERIF
175!   integer iso_verif_positif_nostop
176!#endif
177
178    DO i = 1, knon
179       sst_out(i) = sst(knindex(i))
180    END DO
181
182
183#ifdef ISO
184     if (iso_HTO.gt.0) then
185     if (ok_prod_nucl_tritium) then ! si on active la production nucleaire de tritium
186        DO i = 1, knon
187          tuoce_out(i)=tuoce(knindex(i))
188        END DO
189     endif
190     endif
191#endif
192
193#ifdef ISO
194  if (modif_sst.ge.1) then
195  do i = 1, knon
196    lat_locale=rlat(knindex(i)) 
197    ! test: modification uniforme de la sst
198    if (modif_sst.eq.1) then   
199       sst_out(i)= sst_out(i)+deltaTtest 
200    elseif (modif_sst.eq.2) then   !if (modif_sst.eq.1) then       
201        ! pattern parabolique en dehors des tropiques (sstlatcrit)
202        if (abs(lat_locale).gt.sstlatcrit) then
203          sst_out(i)= sst_out(i)+deltaTtestpoles &
204   &             *(lat_locale**2-sstlatcrit**2) &
205   &             /(90.0**2-sstlatcrit**2)                     
206        endif !if (abs(lat_locale).gt.abs(sstlatcrit)) then
207
208    else if (modif_sst.eq.3) then
209
210        if (abs(lat_locale).gt.abs(sstlatcrit)) then
211            if (abs(lat_locale).gt.sstlatcrit+dsstlatcrit) then
212                sst_out(i)= sst_out(i)+deltaTtestpoles
213            else
214                sst_out(i)= sst_out(i)+deltaTtestpoles &
215    &               *(abs(lat_locale)-sstlatcrit)/dsstlatcrit
216            endif
217        endif
218    endif !if (modif_sst.eq.1) then   
219    enddo !do i = 1, knon
220    endif !if (modif_sst.ge.1) then
221#endif
222#ifdef ISOVERIF
223     do i=1,knon,20
224       call iso_verif_positif(sst_out(i)-100.0,'limit_read 4323')
225     enddo
226#endif
227
228
229#ifdef ISO
230        !* lecture de Roce
231        ! 1) première possibilité: valeur fixe à SMOW
232        DO i = 1, knon
233          do ixt=1,niso
234            Roce(ixt,i)=tcorr(ixt)*toce(ixt)
235          enddo !do ixt=1,niso
236        enddo !DO i = 1, knon
237        ! 2) deuxième possibilité: lecture de la carte
238        ! A FAIRE
239
240        ! lecture pour le tritium
241        if ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) then
242             ! lecture de la carte tritium ocean surface
243             Roce(iso_HTO,i)=tcorr(iso_HTO)*tuoce_out(i)*1.E-18*2.
244        endif       
245#endif 
246
247#ifdef ISOVERIF
248        do i=1,knon
249          if (iso_verif_positif_nostop(370.0-sst_out(i), &
250              'limit_read 368').eq.1) then
251             write(*,*) 'i,knindex,sst_out=',i,knindex,sst_out(i)
252             stop
253          endif
254        enddo
255#endif     
256
257
258  END SUBROUTINE limit_read_sst
259
260!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
261!!
262!! Private subroutine :
263!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
264
265  SUBROUTINE limit_read_tot(itime, dtime, jour, is_modified)
266!
267! Read everything needed from limit.nc
268!
269! 0) Initialize
270! 1) Open the file limit.nc, if it is time
271! 2) Read fraction, if not type_ocean=couple
272! 3) Read sea surface temperature, if not type_ocean=couple
273! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
274! 5) Close file and distribuate variables to all processus
275
276    USE dimphy
277    USE mod_grid_phy_lmdz
278    USE mod_phys_lmdz_para
279    USE surface_data, ONLY : type_ocean, ok_veget
280    USE netcdf
281    USE indice_sol_mod
282#ifdef ISO
283    !USE infotrac_phy, ONLY: use_iso
284    USE isotopes_mod, ONLY : iso_HTO,ok_prod_nucl_tritium
285#ifdef ISOVERIF
286    USE isotopes_verif_mod, ONLY : iso_verif_positif_nostop
287#endif
288#endif
289    USE phys_cal_mod, ONLY : calend, year_len
290    USE print_control_mod, ONLY: lunout, prt_level
291#ifdef CPP_XIOS
292    USE XIOS, ONLY: xios_recv_field
293#endif
294   
295    IMPLICIT NONE
296   
297! In- and ouput arguments
298!****************************************************************************************
299    INTEGER, INTENT(IN) :: itime   ! numero du pas de temps courant
300    INTEGER, INTENT(IN) :: jour    ! jour a lire dans l'annee
301    REAL   , INTENT(IN) :: dtime   ! pas de temps de la physique (en s)
302
303    LOGICAL, INTENT(OUT) :: is_modified  ! true if pctsrf is modified at this time step
304
305! Locals variables with attribute SAVE
306!****************************************************************************************
307! frequence de lecture des conditions limites (en pas de physique)
308    INTEGER,SAVE                              :: lmt_pas
309!$OMP THREADPRIVATE(lmt_pas)
310    LOGICAL, SAVE                             :: first_call=.TRUE.
311!$OMP THREADPRIVATE(first_call) 
312    INTEGER, SAVE                             :: jour_lu = -1
313!$OMP THREADPRIVATE(jour_lu) 
314! Locals variables
315!****************************************************************************************
316    INTEGER                                   :: nid, nvarid, ndimid, nn
317    INTEGER                                   :: ii, ierr
318    INTEGER, DIMENSION(2)                     :: start, epais
319    REAL, DIMENSION(klon_glo,nbsrf)           :: pct_glo  ! fraction at global grid
320    REAL, DIMENSION(klon_glo)                 :: sst_glo  ! sea-surface temperature at global grid
321    REAL, DIMENSION(klon_glo)                 :: rug_glo  ! rugosity at global grid
322    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
323
324    REAL, DIMENSION(klon_mpi,nbsrf)           :: pct_mpi  ! fraction at global grid
325    REAL, DIMENSION(klon_mpi)                 :: sst_mpi  ! sea-surface temperature at global grid
326    REAL, DIMENSION(klon_mpi)                 :: rug_mpi  ! rugosity at global grid
327    REAL, DIMENSION(klon_mpi)                 :: alb_mpi  ! albedo at global grid
328
329    CHARACTER(len=20)                         :: modname='limit_read_mod'     
330    CHARACTER(LEN=99)                         :: abort_message, calendar, str
331#ifdef ISO
332    REAL, DIMENSION(klon_glo)                 :: tuoce_glo  ! sea-surface tritium et global grid
333#endif
334
335! End declaration
336!****************************************************************************************
337
338!****************************************************************************************
339! 0) Initialization
340!
341!****************************************************************************************
342    IF (first_call) THEN
343       first_call=.FALSE.
344       ! calculate number of time steps for one day
345       lmt_pas = NINT(86400./dtime * 1.0)
346       
347       ! Allocate module save variables
348       IF ( type_ocean /= 'couple' ) THEN
349          ALLOCATE(pctsrf(klon,nbsrf), sst(klon), stat=ierr)
350          IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating pctsrf and sst',1)
351       END IF
352
353       IF ( .NOT. ok_veget ) THEN
354          ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
355          IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating rugos and albedo',1)
356       END IF
357
358!$OMP MASTER  ! Only master thread
359       IF (is_mpi_root) THEN ! Only master processus
360          ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
361          IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
362               'Pb d''ouverture du fichier de conditions aux limites',1)
363
364          !--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ
365          ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid)
366          ierr=NF90_GET_ATT(nid, nvarid, 'calendar', calendar)
367          IF(ierr==NF90_NOERR.AND.calendar/=calend.AND.prt_level>=1) THEN
368             WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: '
369             WRITE(lunout,*)'  '//TRIM(calend)//' for gcm'
370             WRITE(lunout,*)'  '//TRIM(calendar)//' for limit.nc file'
371          END IF
372
373          !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS         
374          IF (grid_type==unstructured) THEN
375            ierr=NF90_INQ_DIMID(nid,"time_year",ndimid)
376          ELSE
377            ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
378          ENDIF
379          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
380          WRITE(abort_message,'(a,2(i0,a))')'limit.nc records number (',nn,') does no'//&
381            't match year length (',year_len,')'
382          IF(nn/=year_len) CALL abort_physic(modname,abort_message,1)
383
384          !--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
385          IF (grid_type==unstructured) THEN
386            ierr=NF90_INQ_DIMID(nid, 'cell', ndimid)
387          ELSE
388            ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
389          ENDIF
390          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
391          WRITE(abort_message,'(a,2(i0,a))')'limit.nc horizontal number of cells (',nn, &
392            ') does not match LMDZ klon_glo (',klon_glo,')'
393          IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1)
394
395          ierr = NF90_CLOSE(nid)
396          IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
397       END IF ! is_mpi_root
398!$OMP END MASTER
399!$OMP BARRIER
400    END IF
401
402!****************************************************************************************
403! 1) Open the file limit.nc if it is the right moment to read, once a day.
404!    The file is read only by the master thread of the master mpi process(is_mpi_root)
405!    Check by the way if the number of records is correct.
406!
407!****************************************************************************************
408
409    is_modified = .FALSE.
410!ym    IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN   ! time to read
411!  not REALLY PERIODIC
412    IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN   ! time to read
413!    IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
414       jour_lu = jour
415       is_modified = .TRUE.
416
417      IF (grid_type==unstructured) THEN
418
419#ifdef CPP_XIOS
420        IF ( type_ocean /= 'couple') THEN
421
422           IF (is_omp_master) CALL xios_recv_field("foce_limin",pct_mpi(:,is_oce))
423           IF (is_omp_master) CALL xios_recv_field("fsic_limin",pct_mpi(:,is_sic))
424  !         IF (read_continents .OR. itime == 1) THEN
425           IF (is_omp_master) CALL xios_recv_field("fter_limin",pct_mpi(:,is_ter))
426           IF (is_omp_master) CALL xios_recv_field("flic_limin",pct_mpi(:,is_lic))
427  !         ENDIF
428         ENDIF! type_ocean /= couple
429         
430         IF ( type_ocean /= 'couple') THEN                   
431             IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi)
432         ENDIF
433       
434         IF (.NOT. ok_veget) THEN
435           IF (is_omp_master) CALL xios_recv_field("alb_limin",alb_mpi)
436           IF (is_omp_master) CALL xios_recv_field("rug_limin",rug_mpi)
437         ENDIF
438
439       IF ( type_ocean /= 'couple') THEN
440          CALL Scatter_omp(sst_mpi,sst)
441          CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
442          CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
443!          IF (read_continents .OR. itime == 1) THEN
444             CALL Scatter_omp(pct_mpi(:,is_ter),pctsrf(:,is_ter))
445             CALL Scatter_omp(pct_mpi(:,is_lic),pctsrf(:,is_lic))
446!          END IF
447       END IF
448
449       IF (.NOT. ok_veget) THEN
450          CALL Scatter_omp(alb_mpi, albedo)
451          CALL Scatter_omp(rug_mpi, rugos)
452       END IF
453#endif
454
455 
456     ELSE      ! grid_type==regular
457
458!$OMP MASTER  ! Only master thread
459       IF (is_mpi_root) THEN ! Only master processus!
460
461          ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
462          IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
463               'Pb d''ouverture du fichier de conditions aux limites',1)
464
465          ! La tranche de donnees a lire:
466          start(1) = 1
467          start(2) = jour
468          epais(1) = klon_glo
469          epais(2) = 1
470
471
472!****************************************************************************************
473! 2) Read fraction if not type_ocean=couple
474!
475!****************************************************************************************
476
477          IF ( type_ocean /= 'couple') THEN
478!
479! Ocean fraction
480             ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
481             IF (ierr /= NF90_NOERR) CALL abort_physic(modname, 'Le champ <FOCE> est absent',1)
482             
483             ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_oce),start,epais)
484             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FOCE>' ,1)
485!
486! Sea-ice fraction
487             ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)
488             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FSIC> est absent',1)
489
490             ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_sic),start,epais)
491             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FSIC>' ,1)
492
493
494! Read land and continentals fraction only if asked for
495             IF (read_continents .OR. itime == 1) THEN
496!
497! Land fraction
498                ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)
499                IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FTER> est absent',1)
500               
501                ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_ter),start,epais)
502                IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FTER>',1)
503!
504! Continentale ice fraction
505                ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)
506                IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FLIC> est absent',1)
507
508                ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_lic),start,epais)
509                IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FLIC>',1)
510             END IF
511
512          END IF ! type_ocean /= couple
513
514!****************************************************************************************
515! 3) Read sea-surface temperature, if not coupled ocean
516!
517!****************************************************************************************
518          IF ( type_ocean /= 'couple') THEN
519
520             ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
521             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <SST> est absent',1)
522
523             ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
524             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <SST>',1)
525         
526#ifdef ISO
527             IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
528               ierr = NF90_INQ_VARID(nid, 'TUOCE', nvarid)
529               IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <TUOCE> est absent',1)
530
531               ierr = NF90_GET_VAR(nid,nvarid,tuoce_glo,start,epais)
532               IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <TUOCE>',1)
533             END IF
534#ifdef ISOVERIF
535             do ii=1,klon_glo
536               if (iso_verif_positif_nostop(370.0-sst_glo(ii),  &
537                'limit_read 384').eq.1) then
538                 write(*,*) 'ii,sst_glo=',ii,sst_glo(ii)
539                 write(*,*) 'jour,start,epais=',jour,start,epais
540                 stop
541               endif
542             enddo
543#endif
544#endif
545
546          END IF
547
548!****************************************************************************************
549! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
550!
551!****************************************************************************************
552
553          IF (.NOT. ok_veget) THEN
554!
555! Read albedo
556             ierr = NF90_INQ_VARID(nid, 'ALB', nvarid)
557             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <ALB> est absent',1)
558
559             ierr = NF90_GET_VAR(nid,nvarid,alb_glo,start,epais)
560             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <ALB>',1)
561!
562! Read rugosity
563             ierr = NF90_INQ_VARID(nid, 'RUG', nvarid)
564             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <RUG> est absent',1)
565
566             ierr = NF90_GET_VAR(nid,nvarid,rug_glo,start,epais)
567             IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <RUG>',1)
568
569          END IF
570
571!****************************************************************************************
572! 5) Close file and distribuate variables to all processus
573!
574!****************************************************************************************
575          ierr = NF90_CLOSE(nid)
576          IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
577       ENDIF ! is_mpi_root
578
579!$OMP END MASTER
580!$OMP BARRIER
581
582       IF ( type_ocean /= 'couple') THEN
583          CALL Scatter(sst_glo,sst)
584          CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
585          CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))
586          IF (read_continents .OR. itime == 1) THEN
587             CALL Scatter(pct_glo(:,is_ter),pctsrf(:,is_ter))
588             CALL Scatter(pct_glo(:,is_lic),pctsrf(:,is_lic))
589          END IF
590#ifdef ISO
591          IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
592             CALL Scatter(tuoce_glo,tuoce)
593          END IF
594#endif
595       END IF
596
597       IF (.NOT. ok_veget) THEN
598          CALL Scatter(alb_glo, albedo)
599          CALL Scatter(rug_glo, rugos)
600       END IF
601
602      ENDIF ! Grid type
603
604    ENDIF ! time to read
605
606  END SUBROUTINE limit_read_tot
607
608END MODULE limit_read_mod
Note: See TracBrowser for help on using the repository browser.