!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. PROGRAM splithdf,5 ! !----------------------------------------------------------------------- ! ! To split apart a ARPS history or data file for use by the ! message passing version of the ARPS. ! !----------------------------------------------------------------------- ! ! MODIFICATION HISTORY. ! ! 2001/04/23 (G. Bassett) Created. ! !----------------------------------------------------------------------- ! IMPLICIT NONE INCLUDE 'mp.inc' ! !----------------------------------------------------------------------- ! ! Misc. local variables: ! !----------------------------------------------------------------------- ! INTEGER :: length INTEGER nxsm,nysm INTEGER nxlg,nylg,nz INTEGER nstyps, ireturn CHARACTER (LEN=120) :: filename REAL, ALLOCATABLE :: buf_r(:,:,:) INTEGER, ALLOCATABLE :: buf_i(:,:,:) INTEGER (KIND=selected_int_kind(4)), ALLOCATABLE:: buf_i16(:,:,:) INTEGER sstat ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! WRITE (*,*) "Enter the filename:" READ (*,'(a)') filename WRITE (*,*) "Enter nproc_x, nproc_y:" READ (*,*) nproc_x, nproc_y CALL get_dims_from_hdf(trim(filename),nxlg,nylg,nz,nstyps, ireturn) IF (ireturn /= 0) THEN WRITE (6,*) 'SPLITHDF: WARNING, error returned from get_dims_from_data', & ireturn ENDIF nxsm = (nxlg - 3)/nproc_x + 3 nysm = (nylg - 3)/nproc_y + 3 ALLOCATE(buf_r(nxsm,nysm,nz)) ALLOCATE(buf_i(nxsm,nysm,nz),stat=sstat) ALLOCATE(buf_i16(nxsm,nysm,nz)) WRITE (6, *) 'Splitting file ...' call mpinit_proc() call mpinit_var() CALL split_hdf(filename,nxsm,nysm,nz,buf_r,buf_i,buf_i16,sstat) WRITE (6, *) 'Done splitting file ...' DEALLOCATE(buf_r) DEALLOCATE(buf_i) DEALLOCATE(buf_i16) call arpsstop("Normal Finish", 0) END PROGRAM splithdf