source: LMDZ6/trunk/libf/phylmd/Dust/read_surface.F90 @ 4660

Last change on this file since 4660 was 4593, checked in by yann meurdesoif, 18 months ago

Replace #include (c preprocessor) by INCLUDE (fortran keyword)

in phylmd (except rrtm and ecrad) filtrez, dy3dmem and dyn3dcommon

Other directories will follow
YM

File size: 4.5 KB
RevLine 
[2630]1       subroutine read_surface(name,surfa)
2
3     
4! common
5! ------
6       USE ioipsl
7!       USE comgeomphy
8       USE dimphy
9       USE mod_grid_phy_lmdz
10       USE mod_phys_lmdz_para
11       USE iophy
12!       USE netcdf
13       IMPLICIT NONE
14
[4593]15       INCLUDE "netcdf.inc"
16       INCLUDE "dimensions.h"
17       INCLUDE "paramet.h"
[2630]18
19       character*10 name
20       character*10 varname
21!
22       real tmp_dyn(iip1,jjp1)
23       real tmp_dyn_glo(nbp_lon+1,nbp_lat)
24!       real tmp_dyn_glo(nbp_lon,nbp_lat)
25       REAL tmp_dyn_invers(iip1,jjp1)
26       real tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
27!       real tmp_dyn_invers_glo(nbp_lon,nbp_lat)
28       real tmp_fi(klon)
29       real tmp_fi_glo(klon_glo)
30       real surfa(klon,5)
31       real surfa_glo(klon_glo,5)
32!
33       integer ncid
34       integer varid
35       real rcode
36       integer start(2),count(2),status
37       integer i,j,l,ig
38       character*1 str1
39
40!JE20140526<<
41      character*4 ::  latstr,aux4s
42      logical :: outcycle, isinversed
43      real, dimension(jjp1) :: lats
44      real, dimension(nbp_lat) :: lats_glo
45      real :: rcode2
46      integer, dimension(1) :: startj,endj
47!JE20140526>>
48!$OMP MASTER
49       IF (is_mpi_root .AND. is_omp_root) THEN
50
51       print*,'Lecture du fichier donnees_lisa.nc'
52       ncid=NCOPN('donnees_lisa.nc',NCNOWRIT,rcode)
53
54!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa
55      outcycle=.false.
56      latstr='null'
57      isinversed=.false.
58      do i=1,5
59       if (i==1) aux4s='latu'
60       if (i==2) aux4s='LATU'
61       if (i==3) aux4s='LatU'
62       if (i==4) aux4s='Latu'
63       if (i==5) aux4s='latU'
64       status = NF_INQ_VARID (ncid, aux4s, rcode)
65!       print *,'stat,i',status,i,outcycle,aux4s
66!       print *,'ifclause',status.NE. NF_NOERR ,outcycle == .false.
67       IF ((.not.(status.NE. NF_NOERR) ).and.( .not. outcycle )) THEN
68         outcycle=.true.
69         latstr=aux4s
70       ENDIF
71      enddo ! check if it inversed lat
72      startj(1)=1
73!      endj(1)=jjp1
74      endj(1)=nbp_lat
75      varid=NCVID(ncid,latstr,rcode)
76
77#ifdef NC_DOUBLE
78          status=NF_GET_VARA_DOUBLE(ncid,varid,startj,endj,lats_glo)
79#else
80          status=NF_GET_VARA_REAL(ncid,varid,startj,endj,lats_glo)
81#endif
82!      print *,latstr,varid,status,jjp1,rcode
83!      IF (status .NE. NF_NOERR) print*,'NOOOOOOO'
84!      print *,lats
85!stop
86
87! check if netcdf is latitude inversed or not.
88      if (lats_glo(1)<lats_glo(2)) isinversed=.true.
89! JE20140526>>
90
91
92       DO i=1,5
93          write(str1,'(i1)') i
94          varname=trim(name)//str1
95       print*,'lecture variable:',varname
96          varid=NCVID(ncid,trim(varname),rcode)
97!          varid=NCVID(ncid,varname,rcode)
98
99!  dimensions pour les champs scalaires et le vent zonal
100!  -----------------------------------------------------
101
102          start(1)=1
103          start(2)=1     
104          count(1)=nbp_lon+1
105!          count(1)=iip1
106          count(2)=nbp_lat
107!          count(2)=jjp1
108
109! mise a zero des tableaux
110! ------------------------
111          tmp_dyn(:,:)=0.0
112          tmp_fi(:)=0.0
113! Lecture
114! -----------------------
115#ifdef NC_DOUBLE
116          status=NF_GET_VARA_DOUBLE(ncid,varid,start,count,tmp_dyn_glo)
117#else
118          status=NF_GET_VARA_REAL(ncid,varid,start,count,tmp_dyn_glo)
119#endif
120
121!      call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn   ')
122       DO j=1, nbp_lat
123          DO ig=1, nbp_lon+1
124             tmp_dyn_invers_glo(ig,j)=tmp_dyn_glo(ig,nbp_lat-j+1)
125          ENDDO
126       ENDDO
127
128       
129!JE20140522!          call gr_dyn_fi_p(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi)
130
131!JE20140526<<
132!              call gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi)
133           if (isinversed) then
134                        call gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, &
135     & tmp_dyn_invers_glo, tmp_fi_glo)
136!              call gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi)
137!              call gr_dyn_fi_p(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi)
138           else     
139                        call gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, &
140     &   tmp_dyn_glo, tmp_fi_glo)
141!              call gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn, tmp_fi)
142!              call gr_dyn_fi_p(1, iip1, jjp1, klon, tmp_dyn, tmp_fi)
143           endif
144!JE20140526>>
145!      call dump2d(iim,jjm-1,tmp_fi(2),'tmp_fi   ')
146!
147          DO j=1,klon_glo
148
149                surfa_glo(j,i)=tmp_fi_glo(j)
150
151          ENDDO ! Fin de recopie du tableau
152!
153       ENDDO ! Fin boucle 1 a 5
154       print*,'Passage Grille Dyn -> Phys'
155
156
157      ENDIF !mpi
158!$OMP END MASTER
159!$OMP BARRIER
160      call scatter(surfa_glo,surfa)
161
162
163       return
164       end subroutine read_surface
Note: See TracBrowser for help on using the repository browser.