source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/read_dust.F @ 2404

Last change on this file since 2404 was 2175, checked in by jescribano, 10 years ago

SPLA code included for first time

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