source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90 @ 5119

Last change on this file since 5119 was 5117, checked in by abarral, 4 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

File size: 3.5 KB
Line 
1SUBROUTINE 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
104END SUBROUTINE read_vent
105
106! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
107SUBROUTINE 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
124END SUBROUTINE  correctbid
125
126
127
Note: See TracBrowser for help on using the repository browser.