source: LMDZ6/branches/LMDZ-QUEST/libf/phylmd/Dust/read_vent.F @ 3582

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

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

File size: 4.1 KB
Line 
1      SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec)
2      USE dimphy
3      USE mod_grid_phy_lmdz
4      USE mod_phys_lmdz_para
5!      USE write_field_phy
6      IMPLICIT NONE
7#include "dimensions.h"
8c #include "dimphy.h"
9#include "paramet.h"
10#include "netcdf.inc"
11c
12      INTEGER step, nbjour
13      LOGICAL debutphy
14      real u10m_ec(klon), v10m_ec(klon)
15      real u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)
16c
17!      real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72
18!      real v10m_nc(iip1,jjp1)  ! dim 97x73
19      real u10m_nc_glo(nbp_lon+1,nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
20      real v10m_nc_glo(nbp_lon+1,nbp_lat)  ! dim 97x73
21      real rcode
22      integer ncidu1, varidu1, ncidv1, varidv1
23      save ncidu1, varidu1, ncidv1, varidv1
24!$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
25      integer start(4),count(4), status
26      integer i, j, ig
27
28
29c
30!$OMP MASTER
31      IF (is_mpi_root .AND. is_omp_root) THEN
32      if (debutphy) then
33c
34         ncidu1=NCOPN('u10m.nc',NCNOWRIT,rcode)
35         varidu1=NCVID(ncidu1,'UWND',rcode)
36         ncidv1=NCOPN('v10m.nc',NCNOWRIT,rcode)
37         varidv1=NCVID(ncidv1,'VWND',rcode)
38c
39      endif
40c
41      start(1)=1
42      start(2)=1
43      start(4)=0
44
45!      count(1)=iip1
46      count(1)=nbp_lon+1
47!      count(2)=jjp1
48      count(2)=nbp_lat
49      count(3)=1
50      count(4)=0
51c
52      start(3)=step
53c
54#ifdef NC_DOUBLE
55!      status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc)
56      status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc_glo)
57#else
58!      status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc)
59      status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc_glo)
60#endif
61!       print *,status
62c
63#ifdef NC_DOUBLE
64!      status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc)
65      status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc_glo)
66#else
67!      status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc)
68      status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc_glo)
69#endif
70c
71
72!      print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1)
73!      print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1)
74
75!       print *,status
76!      call correctbid(iim,jjp1,u10m_nc)
77!      call correctbid(iim,jjp1,v10m_nc)
78      call correctbid(nbp_lon,nbp_lat,u10m_nc_glo)
79      call correctbid(nbp_lon,nbp_lat,v10m_nc_glo)
80
81!      print *,'afterbidcor u10m_nc', u10m_nc(1,jjp1)
82!      print *,'afterbidcor v10m_nc', v10m_nc(1,jjp1)
83c
84c--upside down + physical grid
85c
86!      u10m_ec(1)=u10m_nc(1,jjp1)
87!      v10m_ec(1)=v10m_nc(1,jjp1)
88      u10m_ec_glo(1)=u10m_nc_glo(1,nbp_lat)
89      v10m_ec_glo(1)=v10m_nc_glo(1,nbp_lat)
90      ig=2
91!      DO j=2,jjm
92!         DO i = 1, iim
93      DO j=2,nbp_lat-1
94         DO i = 1, nbp_lon
95!           u10m_ec(ig)=u10m_nc(i,jjp1+1-j)
96!           v10m_ec(ig)=v10m_nc(i,jjp1+1-j)
97           u10m_ec_glo(ig)=u10m_nc_glo(i,nbp_lat+1-j)
98           v10m_ec_glo(ig)=v10m_nc_glo(i,nbp_lat+1-j)
99           ig=ig+1
100!         print *,u10m_ec(ig) ,v10m_ec(ig)
101         ENDDO
102      ENDDO
103      u10m_ec_glo(ig)=u10m_nc_glo(1,1)
104      v10m_ec_glo(ig)=v10m_nc_glo(1,1)
105
106
107!      end if master
108      ENDIF
109!$OMP END MASTER
110!$OMP BARRIER
111      CALL scatter(u10m_ec_glo,u10m_ec)
112      CALL scatter(v10m_ec_glo,v10m_ec)
113
114!      print *,'JE  tamagno viento ig= ', ig
115!      print *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec),
116!     .                                      MAXVAL(u10m_ec)
117!      print *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec),
118!     .                                      MAXVAL(v10m_ec)
119!       print *,'u v 1 ', u10m_ec(1),v10m_ec(1)
120!       print *,'u v klon ', u10m_ec(klon),v10m_ec(klon)
121      RETURN
122      END
123
124c added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
125      subroutine correctbid(iim,nl,x)
126      integer iim,nl
127      real x(iim+1,nl)
128      integer i,l
129      real zz
130
131      do l=1,nl
132         do i=2,iim-1
133            if(abs(x(i,l)).gt.1.e10) then
134               zz=0.5*(x(i-1,l)+x(i+1,l))
135c              print*,'correction ',i,l,x(i,l),zz
136               x(i,l)=zz
137            endif
138         enddo
139      enddo
140
141      return
142      end
143
144
145
Note: See TracBrowser for help on using the repository browser.