source: LMDZ5/trunk/libf/phylmd/Dust/read_dust.F

Last change on this file was 2630, checked in by fhourdin, 8 years ago

Importation du modèle d'aérosols de Boucher, Escribano et al.

File size: 2.0 KB
RevLine 
[2630]1      SUBROUTINE read_dust(debutphy, step, nbjour, dust_ec)
2      USE dimphy
3      USE mod_grid_phy_lmdz
4      USE mod_phys_lmdz_para
5      IMPLICIT NONE
6c
7#include "dimensions.h"
8#include "paramet.h"
9#include "netcdf.inc"
10c
11      INTEGER step, nbjour
12      LOGICAL debutphy
13      real dust_ec(klon)
14      real dust_ec_glo(klon_glo)
15c
16      real dust_nc(iip1,jjp1)
17      real dust_nc_glo(nbp_lon+1,nbp_lat)
18      real rcode
19      integer ncid1, varid1, ncid2, varid2
20
21      save ncid1, varid1, ncid2, varid2
22!$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2)
23      integer start(4),count(4), status
24      integer i, j, ig
25c
26!$OMP MASTER
27      IF (is_mpi_root .AND. is_omp_root) THEN
28      if (debutphy) then
29c
30         ncid1=NCOPN('dust.nc',NCNOWRIT,rcode)
31         varid1=NCVID(ncid1,'EMISSION',rcode)
32c
33      endif
34c
35      start(1)=1
36      start(2)=1
37      start(4)=0
38
39!      count(1)=iip1
40      count(1)=nbp_lon+1
41!      count(2)=jjp1
42      count(2)=nbp_lat
43      count(3)=1
44      count(4)=0
45c
46      start(3)=step
47c
48#ifdef NC_DOUBLE
49!      status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc)
50      status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc_glo)
51#else
52!      status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc)
53      status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc_glo)
54#endif
55c
56!      call correctbid(iim,jjp1,dust_nc)
57      call correctbid(nbp_lon,nbp_lat,dust_nc_glo)
58c
59c--upside down + physical grid
60c
61c--OB=change jjp1 to 1 here
62!      dust_ec(1)=MAX(dust_nc(1,jjp1),0.0)
63      dust_ec(1)=MAX(dust_nc(1,nbp_lat),0.0)
64      ig=2
65!      DO j=2,jjm
66      DO j=2,nbp_lat-1
67!         DO i = 1, iim
68         DO i = 1, nbp_lon
69c--OB=change jjp1+1-j to j here
70!           dust_ec(ig)=MAX(dust_nc(i,jjp1+1-j),0.0)
71           dust_ec_glo(ig)=MAX(dust_nc_glo(i,nbp_lat+1-j),0.0)
72           ig=ig+1
73         ENDDO
74      ENDDO
75c--OB=change second 1 to jjp1 here
76      dust_ec_glo(ig)=MAX(dust_nc_glo(1,1),0.0)
77!      end if master
78      ENDIF
79!$OMP END MASTER
80!$OMP BARRIER
81      CALL scatter(dust_ec_glo,dust_ec)
82c
83      RETURN
84      END
Note: See TracBrowser for help on using the repository browser.