1 | SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec) |
---|
2 | USE dimphy |
---|
3 | USE lmdz_grid_phy |
---|
4 | USE lmdz_phys_para |
---|
5 | USE netcdf, ONLY: nf90_get_var, nf90_open, nf90_inq_varid, nf90_nowrite |
---|
6 | IMPLICIT NONE |
---|
7 | INCLUDE "dimensions.h" |
---|
8 | INCLUDE "paramet.h" |
---|
9 | |
---|
10 | INTEGER :: step, nbjour |
---|
11 | LOGICAL :: debutphy |
---|
12 | REAL :: u10m_ec(klon), v10m_ec(klon) |
---|
13 | REAL :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo) |
---|
14 | |
---|
15 | ! real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72 |
---|
16 | ! real v10m_nc(iip1,jjp1) ! dim 97x73 |
---|
17 | REAL :: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72 |
---|
18 | REAL :: v10m_nc_glo(nbp_lon + 1, nbp_lat) ! dim 97x73 |
---|
19 | INTEGER :: rcode |
---|
20 | INTEGER :: ncidu1, varidu1, ncidv1, varidv1 |
---|
21 | save ncidu1, varidu1, ncidv1, varidv1 |
---|
22 | !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1) |
---|
23 | INTEGER :: start(4), count(4), status |
---|
24 | INTEGER :: i, j, ig |
---|
25 | |
---|
26 | !$OMP MASTER |
---|
27 | IF (is_mpi_root .AND. is_omp_root) THEN |
---|
28 | IF (debutphy) THEN |
---|
29 | ncidu1 = nf90_open('u10m.nc', nf90_nowrite, rcode) |
---|
30 | varidu1 = nf90_inq_varid(ncidu1, 'U10M', rcode) |
---|
31 | ncidv1 = nf90_open('v10m.nc', nf90_nowrite, rcode) |
---|
32 | varidv1 = nf90_inq_varid(ncidv1, 'V10M', rcode) |
---|
33 | |
---|
34 | endif |
---|
35 | |
---|
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 |
---|
46 | |
---|
47 | start(3) = step |
---|
48 | |
---|
49 | status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count) |
---|
50 | |
---|
51 | status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count) |
---|
52 | |
---|
53 | |
---|
54 | ! print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1) |
---|
55 | ! print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1) |
---|
56 | |
---|
57 | ! print *,status |
---|
58 | ! CALL correctbid(iim,jjp1,u10m_nc) |
---|
59 | ! CALL correctbid(iim,jjp1,v10m_nc) |
---|
60 | CALL correctbid(nbp_lon, nbp_lat, u10m_nc_glo) |
---|
61 | CALL correctbid(nbp_lon, nbp_lat, v10m_nc_glo) |
---|
62 | |
---|
63 | ! print *,'afterbidcor u10m_nc', u10m_nc(1,jjp1) |
---|
64 | ! print *,'afterbidcor v10m_nc', v10m_nc(1,jjp1) |
---|
65 | |
---|
66 | !--upside down + physical grid |
---|
67 | |
---|
68 | ! u10m_ec(1)=u10m_nc(1,jjp1) |
---|
69 | ! v10m_ec(1)=v10m_nc(1,jjp1) |
---|
70 | u10m_ec_glo(1) = u10m_nc_glo(1, nbp_lat) |
---|
71 | v10m_ec_glo(1) = v10m_nc_glo(1, nbp_lat) |
---|
72 | ig = 2 |
---|
73 | ! DO j=2,jjm |
---|
74 | ! DO i = 1, iim |
---|
75 | DO j = 2, nbp_lat - 1 |
---|
76 | DO i = 1, nbp_lon |
---|
77 | ! u10m_ec(ig)=u10m_nc(i,jjp1+1-j) |
---|
78 | ! v10m_ec(ig)=v10m_nc(i,jjp1+1-j) |
---|
79 | u10m_ec_glo(ig) = u10m_nc_glo(i, nbp_lat + 1 - j) |
---|
80 | v10m_ec_glo(ig) = v10m_nc_glo(i, nbp_lat + 1 - j) |
---|
81 | ig = ig + 1 |
---|
82 | ! print *,u10m_ec(ig) ,v10m_ec(ig) |
---|
83 | ENDDO |
---|
84 | ENDDO |
---|
85 | u10m_ec_glo(ig) = u10m_nc_glo(1, 1) |
---|
86 | v10m_ec_glo(ig) = v10m_nc_glo(1, 1) |
---|
87 | |
---|
88 | |
---|
89 | ! end if master |
---|
90 | ENDIF |
---|
91 | !$OMP END MASTER |
---|
92 | !$OMP BARRIER |
---|
93 | CALL scatter(u10m_ec_glo, u10m_ec) |
---|
94 | CALL scatter(v10m_ec_glo, v10m_ec) |
---|
95 | |
---|
96 | ! print *,'JE tamagno viento ig= ', ig |
---|
97 | ! print *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec), |
---|
98 | ! . MAXVAL(u10m_ec) |
---|
99 | ! print *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec), |
---|
100 | ! . MAXVAL(v10m_ec) |
---|
101 | ! print *,'u v 1 ', u10m_ec(1),v10m_ec(1) |
---|
102 | ! print *,'u v klon ', u10m_ec(klon),v10m_ec(klon) |
---|
103 | |
---|
104 | END SUBROUTINE read_vent |
---|
105 | |
---|
106 | ! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more |
---|
107 | SUBROUTINE correctbid(iim, nl, x) |
---|
108 | INTEGER :: iim, nl |
---|
109 | REAL :: x(iim + 1, nl) |
---|
110 | INTEGER :: i, l |
---|
111 | REAL :: zz |
---|
112 | |
---|
113 | do l = 1, nl |
---|
114 | do i = 2, iim - 1 |
---|
115 | IF(abs(x(i, l))>1.e10) THEN |
---|
116 | zz = 0.5 * (x(i - 1, l) + x(i + 1, l)) |
---|
117 | ! PRINT*,'correction ',i,l,x(i,l),zz |
---|
118 | x(i, l) = zz |
---|
119 | endif |
---|
120 | enddo |
---|
121 | enddo |
---|
122 | |
---|
123 | |
---|
124 | END SUBROUTINE correctbid |
---|
125 | |
---|
126 | |
---|
127 | |
---|