Changeset 440 for IOIPSL/trunk
 Timestamp:
 11/26/08 11:58:38 (16 years ago)
 Location:
 IOIPSL/trunk/src
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

IOIPSL/trunk/src/histcom.f90
r429 r440 9 9 ! 10 10 USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase 11 USE mathelp, ONLY : mathop,moycum, trans_buff,buildop11 USE mathelp, ONLY : mathop,moycum,buildop 12 12 USE fliocom, ONLY : flio_dom_file,flio_dom_att 13 13 USE calendar … … 147 147 ! 148 148 INTEGER,SAVE :: buff_pos=0 149 REAL,ALLOCATABLE, SAVE :: buffer(:)149 REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buffer 150 150 LOGICAL,DIMENSION(nb_files_max),SAVE :: zoom=.FALSE.,regular=.TRUE. 151 151 ! … … 780 780 INTEGER :: iret,ncid,twoid 781 781 LOGICAL :: transp = .FALSE. 782 REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans782 REAL,ALLOCATABLE,DIMENSION(:,:),SAVE :: bounds_trans 783 783 LOGICAL :: l_dbg 784 784 ! … … 1754 1754 INTEGER,DIMENSION(2) :: nbpt_in2 1755 1755 INTEGER,DIMENSION(3) :: nbpt_in3 1756 REAL,ALLOCATABLE, SAVE :: buff_tmp(:)1756 REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp 1757 1757 INTEGER,SAVE :: buff_tmp_sz 1758 1758 CHARACTER(LEN=7) :: tmp_opp … … 1942 1942 ! 1943 1943 INTEGER :: tsz,ncid,ncvarid,i,iret,ipt,itax,io,nbin,nbout 1944 INTEGER :: nx,ny,nz,ky,kz,kt,kc 1944 1945 INTEGER,DIMENSION(4) :: corner,edges 1945 1946 INTEGER :: itime … … 1947 1948 REAL :: rtime 1948 1949 CHARACTER(LEN=7) :: tmp_opp 1949 REAL,ALLOCATABLE,SAVE :: buff_tmp2(:) 1950 INTEGER,SAVE :: buff_tmp2_sz 1951 REAL,ALLOCATABLE,SAVE :: buffer_used(:) 1952 INTEGER,SAVE :: buffer_sz 1950 REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp2,buffer_used 1951 INTEGER,SAVE :: buff_tmp2_sz,buffer_sz 1953 1952 LOGICAL :: l_dbg 1954 1953 ! … … 2072 2071 & scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3) 2073 2072 ENDIF 2074 CALL trans_buff & 2075 & (zorig(i,varid,1),zsize(i,varid,1), & 2076 & zorig(i,varid,2),zsize(i,varid,2), & 2077 & zorig(i,varid,3),zsize(i,varid,3), & 2078 & scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3), & 2079 & buff_tmp,buff_tmp2_sz,buff_tmp2) 2073 ! 2074 ! We have to consider blocks of contiguous data 2075 ! 2076 nx=MAX(zsize(i,varid,1),1) 2077 ny=MAX(zsize(i,varid,2),1) 2078 nz=MAX(zsize(i,varid,3),1) 2079 IF ( (zorig(i,varid,1) == 1) & 2080 & .AND.(zsize(i,varid,1) == scsize(i,varid,1)) & 2081 & .AND.(zorig(i,varid,2) == 1) & 2082 & .AND.(zsize(i,varid,2) == scsize(i,varid,2))) THEN 2083 kt = (zorig(i,varid,3)1)*nx*ny 2084 buff_tmp2(1:nx*ny*nz) = buff_tmp(kt+1:kt+nx*ny*nz) 2085 ELSEIF ( (zorig(i,varid,1) == 1) & 2086 & .AND.(zsize(i,varid,1) == scsize(i,varid,1))) THEN 2087 kc = nx*ny 2088 DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz1 2089 kc = kc+nx*ny 2090 kt = ((kz1)*scsize(i,varid,2)+zorig(i,varid,2)1)*nx 2091 buff_tmp2(kc+1:kc+nx*ny) = buff_tmp(kt+1:kt+nx*ny) 2092 ENDDO 2093 ELSE 2094 kc = nx 2095 DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz1 2096 DO ky=zorig(i,varid,2),zorig(i,varid,2)+ny1 2097 kc = kc+nx 2098 kt = ((kz1)*scsize(i,varid,2)+ky1)*scsize(i,varid,1) & 2099 & +zorig(i,varid,1)1 2100 buff_tmp2(kc+1:kc+nx) = buff_tmp(kt+1:kt+nx) 2101 ENDDO 2102 ENDDO 2103 ENDIF 2080 2104 ! 2081 2105 ! 4.0 Get the min and max of the field (buff_tmp) … … 2111 2135 nb_opp(pfileid,varid) = nb_opp(pfileid,varid)+1 2112 2136 ! 2113 2137 ENDIF 2114 2138 ! 2115 2139 ! 6.0 Write to file if needed … … 2232 2256 INTEGER,SAVE :: varseq_pos(nb_files_max) 2233 2257 INTEGER,SAVE :: varseq_err(nb_files_max) = 0 2234 INTEGER :: ib,sp,n x,pos2258 INTEGER :: ib,sp,nn,pos 2235 2259 CHARACTER(LEN=70) :: str70 2236 2260 LOGICAL :: l_dbg … … 2313 2337 ! and we can get a guess at the var ID 2314 2338 ! 2315 n x= varseq_pos(pfid)+12316 IF (n x > varseq_len(pfid)) nx= 12317 ! 2318 pvid = varseq(pfid,n x)2339 nn = varseq_pos(pfid)+1 2340 IF (nn > varseq_len(pfid)) nn = 1 2341 ! 2342 pvid = varseq(pfid,nn) 2319 2343 ! 2320 2344 IF (TRIM(name(pfid,pvid)) /= TRIM(pvarname)) THEN … … 2335 2359 ! not defeat the process. 2336 2360 ! 2337 varseq_pos(pfid) = n x2361 varseq_pos(pfid) = nn 2338 2362 ENDIF 2339 2363 ! 
IOIPSL/trunk/src/mathelp.f90
r386 r440 10 10 ! 11 11 PRIVATE 12 PUBLIC :: mathop,moycum, trans_buff,buildop12 PUBLIC :: mathop,moycum,buildop 13 13 ! 14 14 INTERFACE mathop … … 3113 3113 END SUBROUTINE moycum 3114 3114 !=== 3115 SUBROUTINE trans_buff (ox,sx,oy,sy,oz,sz,xsz,ysz,zsz,v3d,sl,v1d)3116 !3117 ! This subroutine extracts from the full 3D variable the slab of3118 ! data that will be used later. Perhaps there are hardware routines3119 ! for this task on some computers. This routine will be obsolete in3120 ! a F90 environnement3121 !3122 !sc V1d = reshape(V3id (ox:ox1+sx,oy:oy1+sy,oz:oz1+sz),3123 !sc SHAPE= (/sx*sy*sz/) )3124 !3125 ! INPUT3126 ! ox : Origin of slab of data in X3127 ! sx : Size of slab in X3128 ! oy : Origin of slab of data in Y3129 ! sy : Size of slab in Y3130 ! oz : Origin of slab of data in Z3131 ! sz : Size of slab in Z3132 ! xsz,ysz,zsz : 3 sizes of full variable v3d3133 ! v3d : The full 3D variable3134 ! sl : size of variable v1d3135 ! v1d : The 1D variable containing the slab3136 !3137 ! VERSION3138 !3139 !3140 IMPLICIT NONE3141 !3142 INTEGER :: ox,sx,oy,sy,oz,sz3143 INTEGER :: xsz,ysz,zsz3144 INTEGER :: sl3145 REAL :: v3d(xsz,ysz,zsz)3146 REAL :: v1d(sl)3147 !3148 INTEGER :: ix,iy,iz,ic3149 !3150 !3151 ! We have to consider the case where the zoom starts at (1,1,1)3152 ! but does not go over the full size.3153 !3154 IF ( (ox .EQ. 1).AND.(oy.EQ. 1).AND.(oz.EQ. 1) &3155 & .AND.(sx .EQ. xsz).AND.(sy .EQ. ysz).AND.(sz .EQ. zsz) ) THEN3156 DO ic=1,MAX(sx,1)*MAX(sy,1)*MAX(sz,1)3157 v1d(ic) = v3d(ic,1,1)3158 ENDDO3159 ELSE IF ( (ox .EQ. 1).AND.(oy .EQ. 1) &3160 & .AND.(sx .EQ. xsz).AND.(sy .EQ. ysz)) THEN3161 DO iz=oz,(oz1+sz)3162 DO ic=1,MAX(sx,1)*MAX(sy,1)3163 v1d(ic) = v3d(ic,1,iz)3164 ENDDO3165 ENDDO3166 ELSE3167 ic = 03168 DO iz=oz,(oz1+sz)3169 DO iy=oy,(oy1+sy)3170 DO ix=ox,(ox1+sx)3171 ic = ic+13172 v1d(ic) = v3d(ix, iy, iz)3173 ENDDO3174 ENDDO3175 ENDDO3176 ENDIF3177 !3178 END SUBROUTINE trans_buff3179 !===3180 3115 ! 3181 3116 END MODULE mathelp
Note: See TracChangeset
for help on using the changeset viewer.