Changeset 1529 for trunk/LMDZ.GENERIC/libf/phystd/writediagspecVI.F
- Timestamp:
- Apr 5, 2016, 10:51:51 AM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.GENERIC/libf/phystd/writediagspecVI.F
r1525 r1529 43 43 ! Addition by RW (2010) to allow OSR to be saved in .nc format 44 44 use radinc_h, only : L_NSPECTV 45 ! USE surfdat_h 46 #ifdef CPP_PARA 45 use comgeomphy, only: airephy 47 46 use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather 48 use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo 49 #endif 47 use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo, 48 & nbp_lon, nbp_lat 50 49 use time_phylmdz_mod, only: ecritphy, iphysiq, day_step, day_ini 51 50 use callkeys_mod, only: iradia … … 53 52 implicit none 54 53 55 ! Commons 56 #include "dimensions.h" 57 !#include "dimphys.h" 58 #include "paramet.h" 59 !#include "control.h" 60 #include "comgeom.h" 61 #include "netcdf.inc" 54 include "netcdf.inc" 62 55 63 56 ! Arguments on input: … … 73 66 ! real dx0 74 67 75 real date76 77 ! REAL phis(ip1jmp1)78 79 68 integer irythme 80 69 integer ierr … … 82 71 integer i,j,l,zmax , ig0 83 72 84 integer zitau 85 character firstnom*20 86 SAVE firstnom 87 SAVE zitau 88 SAVE date 89 data firstnom /'1234567890'/ 90 data zitau /0/ 73 integer,save :: zitau=0 74 character(len=20),save :: firstnom='1234567890' 75 real,save :: date 91 76 !$OMP THREADPRIVATE(firstnom,zitau,date) 92 77 … … 100 85 integer, dimension(4) :: edges,corner 101 86 87 real area((nbp_lon+1),nbp_lat) 102 88 ! added by RDW for OSR output 103 real dx3( iip1,jjp1,L_NSPECTV) ! to store the data set89 real dx3(nbp_lon+1,nbp_lat,L_NSPECTV) ! to store the data set 104 90 105 91 #ifdef CPP_PARA 106 92 ! Added to work in parallel mode 107 93 real dx3_glop(klon_glo,L_NSPECTV) 108 real dx3_glo( iim,jjp1,L_NSPECTV) ! to store a global 3D data set109 #else 110 logical,parameter :: is_master=.true. 111 logical,parameter :: is_mpi_root=.true.94 real dx3_glo(nbp_lon,nbp_lat,L_NSPECTV) ! to store a global 3D data set 95 real areafi_glo(klon_glo) ! mesh area on global physics grid 96 #else 97 real areafi_glo(ngrid) ! mesh area on global physics grid 112 98 #endif 113 99 … … 138 124 endif 139 125 126 #ifdef CPP_PARA 127 ! Gather airephy() mesh area on physics grid 128 call Gather(airephy,areafi_glo) 129 #else 130 areafi_glo(:)=airephy(:) 131 #endif 140 132 ! Create the NetCDF file 141 133 if (is_master) then … … 158 150 ierr = NF_ENDDEF(nid) 159 151 152 ! Build area() 153 do i=1,nbp_lon+1 ! poles 154 ! divide at the poles by nbp_lon 155 area(i,1)=areafi_glo(1)/nbp_lon 156 area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon 157 enddo 158 do j=2,nbp_lat-1 159 ig0= 1+(j-2)*nbp_lon 160 do i=1,nbp_lon 161 area(i,j)=areafi_glo(ig0+i) 162 enddo 163 ! handle redundant point in longitude 164 area(nbp_lon+1,j)=area(1,j) 165 enddo 166 160 167 ! write "header" of file (longitudes, latitudes, geopotential, ...) 161 ! call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis) 162 ! call iniwrite(nid,day_ini,phis) 163 call iniwrite_specVI(nid,day_ini) 168 call iniwrite_specVI(nid,day_ini,area) 164 169 endif ! of if (is_master) 165 170 … … 215 220 endif 216 221 217 write(6,*)'WRITEDIAGSPEC : date= ', date222 write(6,*)'WRITEDIAGSPECVI: date= ', date 218 223 endif ! of if (is_master) 219 224 end if ! of if (nom.eq.firstnom) … … 233 238 call Grid1Dto2D_glo(dx3_glop,dx3_glo) 234 239 ! copy dx3_glo() to dx3(:) and add redundant longitude 235 dx3(1: iim,:,:)=dx3_glo(1:iim,:,:)236 dx3( iip1,:,:)=dx3(1,:,:)240 dx3(1:nbp_lon,:,:)=dx3_glo(1:nbp_lon,:,:) 241 dx3(nbp_lon+1,:,:)=dx3(1,:,:) 237 242 endif 238 243 !$OMP END MASTER … … 240 245 #else 241 246 DO l=1,L_NSPECTV 242 DO i=1, iip1247 DO i=1,nbp_lon+1 243 248 dx3(i,1,l)=px(1,l) 244 dx3(i, jjp1,l)=px(ngrid,l)249 dx3(i,nbp_lat,l)=px(ngrid,l) 245 250 ENDDO 246 DO j=2, jjm247 ig0= 1+(j-2)* iim248 DO i=1, iim251 DO j=2,nbp_lat-1 252 ig0= 1+(j-2)*nbp_lon 253 DO i=1,nbp_lon 249 254 dx3(i,j,l)=px(ig0+i,l) 250 255 ENDDO 251 dx3( iip1,j,l)=dx3(1,j,l)256 dx3(nbp_lon+1,j,l)=dx3(1,j,l) 252 257 ENDDO 253 258 ENDDO … … 279 284 corner(4)=ntime 280 285 281 edges(1)= iip1282 edges(2)= jjp1286 edges(1)=nbp_lon+1 287 edges(2)=nbp_lat 283 288 edges(3)=L_NSPECTV 284 289 edges(4)=1
Note: See TracChangeset
for help on using the changeset viewer.