Changeset 440 for IOIPSL


Ignore:
Timestamp:
11/26/08 11:58:38 (15 years ago)
Author:
bellier
Message:

Removing trans_buff

Location:
IOIPSL/trunk/src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • IOIPSL/trunk/src/histcom.f90

    r429 r440  
    99!- 
    1010  USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase 
    11   USE mathelp,  ONLY : mathop,moycum,trans_buff,buildop 
     11  USE mathelp,  ONLY : mathop,moycum,buildop 
    1212  USE fliocom,  ONLY : flio_dom_file,flio_dom_att 
    1313  USE calendar 
     
    147147!- 
    148148  INTEGER,SAVE :: buff_pos=0 
    149   REAL,ALLOCATABLE,SAVE :: buffer(:) 
     149  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buffer 
    150150  LOGICAL,DIMENSION(nb_files_max),SAVE :: zoom=.FALSE.,regular=.TRUE. 
    151151!- 
     
    780780  INTEGER :: iret,ncid,twoid 
    781781  LOGICAL :: transp = .FALSE. 
    782   REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans 
     782  REAL,ALLOCATABLE,DIMENSION(:,:),SAVE :: bounds_trans 
    783783  LOGICAL :: l_dbg 
    784784!--------------------------------------------------------------------- 
     
    17541754  INTEGER,DIMENSION(2) :: nbpt_in2 
    17551755  INTEGER,DIMENSION(3) :: nbpt_in3 
    1756   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1756  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp 
    17571757  INTEGER,SAVE :: buff_tmp_sz 
    17581758  CHARACTER(LEN=7) :: tmp_opp 
     
    19421942!- 
    19431943  INTEGER :: tsz,ncid,ncvarid,i,iret,ipt,itax,io,nbin,nbout 
     1944  INTEGER :: nx,ny,nz,ky,kz,kt,kc 
    19441945  INTEGER,DIMENSION(4) :: corner,edges 
    19451946  INTEGER :: itime 
     
    19471948  REAL :: rtime 
    19481949  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 
    19531952  LOGICAL :: l_dbg 
    19541953!--------------------------------------------------------------------- 
     
    20722071 &     scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3) 
    20732072    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)+nz-1 
     2089        kc = kc+nx*ny 
     2090        kt = ((kz-1)*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)+nz-1 
     2096        DO ky=zorig(i,varid,2),zorig(i,varid,2)+ny-1 
     2097          kc = kc+nx 
     2098          kt = ((kz-1)*scsize(i,varid,2)+ky-1)*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 
    20802104!- 
    20812105!-- 4.0 Get the min and max of the field (buff_tmp) 
     
    21112135    nb_opp(pfileid,varid) = nb_opp(pfileid,varid)+1 
    21122136!- 
    2113    ENDIF 
     2137  ENDIF 
    21142138!- 
    21152139! 6.0 Write to file if needed 
     
    22322256  INTEGER,SAVE :: varseq_pos(nb_files_max) 
    22332257  INTEGER,SAVE :: varseq_err(nb_files_max) = 0 
    2234   INTEGER      :: ib,sp,nx,pos 
     2258  INTEGER      :: ib,sp,nn,pos 
    22352259  CHARACTER(LEN=70) :: str70 
    22362260  LOGICAL :: l_dbg 
     
    23132337!--     and we can get a guess at the var ID 
    23142338!- 
    2315     nx = varseq_pos(pfid)+1 
    2316     IF (nx > varseq_len(pfid)) nx = 1 
    2317 !- 
    2318     pvid = varseq(pfid,nx) 
     2339    nn = varseq_pos(pfid)+1 
     2340    IF (nn > varseq_len(pfid)) nn = 1 
     2341!- 
     2342    pvid = varseq(pfid,nn) 
    23192343!- 
    23202344    IF (TRIM(name(pfid,pvid)) /= TRIM(pvarname)) THEN 
     
    23352359!---- not defeat the process. 
    23362360!- 
    2337       varseq_pos(pfid) = nx 
     2361      varseq_pos(pfid) = nn 
    23382362    ENDIF 
    23392363!- 
  • IOIPSL/trunk/src/mathelp.f90

    r386 r440  
    1010!- 
    1111  PRIVATE 
    12   PUBLIC :: mathop,moycum,trans_buff,buildop 
     12  PUBLIC :: mathop,moycum,buildop 
    1313!- 
    1414  INTERFACE mathop 
     
    31133113END SUBROUTINE moycum 
    31143114!=== 
    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 of 
    3118 !- data that will be used later. Perhaps there are hardware routines 
    3119 !- for this task on some computers. This routine will be obsolete in 
    3120 !- a F90 environnement 
    3121 !- 
    3122 !-sc   V1d = reshape(V3id (ox:ox-1+sx,oy:oy-1+sy,oz:oz-1+sz), 
    3123 !-sc                 SHAPE= (/sx*sy*sz/) ) 
    3124 !- 
    3125 !- INPUT 
    3126 !- ox  : Origin of slab of data in X 
    3127 !- sx  : Size of slab in X 
    3128 !- oy  : Origin of slab of data in Y 
    3129 !- sy  : Size of slab in Y 
    3130 !- oz  : Origin of slab of data in Z 
    3131 !- sz  : Size of slab in Z 
    3132 !- xsz,ysz,zsz : 3 sizes of full variable v3d 
    3133 !- v3d : The full 3D variable 
    3134 !- sl  : size of variable v1d 
    3135 !- v1d : The 1D variable containing the slab 
    3136 !- 
    3137 !- VERSION 
    3138 !- 
    3139 !--------------------------------------------------------------------- 
    3140   IMPLICIT NONE 
    3141 !- 
    3142   INTEGER :: ox,sx,oy,sy,oz,sz 
    3143   INTEGER :: xsz,ysz,zsz 
    3144   INTEGER :: sl 
    3145   REAL :: v3d(xsz,ysz,zsz) 
    3146   REAL :: v1d(sl) 
    3147 !- 
    3148   INTEGER :: ix,iy,iz,ic 
    3149 !--------------------------------------------------------------------- 
    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) ) THEN  
    3156     DO ic=1,MAX(sx,1)*MAX(sy,1)*MAX(sz,1)  
    3157       v1d(ic) = v3d(ic,1,1) 
    3158     ENDDO  
    3159   ELSE IF (     (ox .EQ. 1).AND.(oy .EQ. 1) & 
    3160  &         .AND.(sx .EQ. xsz).AND.(sy .EQ. ysz)) THEN  
    3161     DO iz=oz,(oz-1+sz)  
    3162       DO ic=1,MAX(sx,1)*MAX(sy,1)  
    3163         v1d(ic) = v3d(ic,1,iz) 
    3164       ENDDO 
    3165     ENDDO 
    3166   ELSE  
    3167     ic = 0 
    3168     DO iz=oz,(oz-1+sz) 
    3169       DO iy=oy,(oy-1+sy) 
    3170         DO ix=ox,(ox-1+sx) 
    3171           ic = ic+1 
    3172           v1d(ic) = v3d(ix, iy, iz) 
    3173         ENDDO 
    3174       ENDDO 
    3175     ENDDO 
    3176   ENDIF 
    3177 !------------------------ 
    3178 END SUBROUTINE trans_buff 
    3179 !=== 
    31803115!----------------- 
    31813116END MODULE mathelp 
Note: See TracChangeset for help on using the changeset viewer.