!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& program out4mpi implicit none include "param_o.h" call out4mpi_1(im,jm,nm,lm,ilm,jlm,ixm,jym) end program out4mpi subroutine out4mpi_1(im,jm,nm,lm,ilm,jlm,ixm,jym) !*********************************************************************** ! * ! Output for mpi run * ! * !*********************************************************************** implicit none integer(KIND=4), intent(in) :: im,jm,nm,lm,ilm,jlm,ixm,jym include 'fcstdata.h' include 'const.h' !----------------------------------------------------------------------- real(KIND=4), dimension (0:im+1,0:jm+1,nm) :: pd,tg real(KIND=4), dimension (0:im+1,0:jm+1,nm,lm) :: t, q, u, v !----------------------------------------------------------------------- ! For common /dynam/ !----------------------------------------------------------------------- real(KIND=4) :: fadv, fadt, rd, f4d, ef4t, fkin, fcp ,fadv2!, msstt(IM+1,JM+1,nm,T) real(KIND=4), dimension (lm) :: deta, rdeta, aeta, daeta,f4q2 real(KIND=4), dimension (lm+1) :: eta, dfl real(KIND=4), dimension (0:im+1,0:jm+1,nm) :: wpdar, f11, f12, f21, f22, & p11, p12, p21, p22, fdiv, fddmp & ,hsinp,hcosp,fvdiff,DXVDX, DXVDY, DYVDX, & DYVDY, DZVDX, DZVDY, RSQV, VCOSP, VSINP, VLAM, VPHI, RSQH, & HLAM, HPHI,qbv11,qbv12,qbv22!,sstm !----------------------------------------------------------------------- ! For common /ctlblk/ !----------------------------------------------------------------------- !----------------------------------------------------------------------- real(KIND=4), dimension (0:im+1,0:jm+1,nm) ::& & sqv, sqh, q11, q12, q22, hbmsk, qh11, qh12, qh22, sqv_norm real(KIND=4), dimension(0:im+1,0:jm+1,nm,4) ::& & qd11, qd12, qd21, qd22 !----------------------------------------------------------------------- character(len=4) ftag character (len=256) :: filename,fname1,init_out,mpi_out,monthlysst integer(KIND=4)::i,j,n,l,list20,list21,list22,list23,mype,iy,jmax,ix,jmin & ,imax,i1,j1,imin, M real(KIND=4),dimension(0:im+1,0:jm+1,nm,lm)::ktdt real(KIND=4),dimension(lm)::kvdt real(KIND=4)::delty,delthz,kappa,p0,rtdf real(KIND=4),dimension(0:im+1,0:jm+1,nm)::fis,res,sst,epsr,sm,sice,vegfrc & ,sno,albedo,si,albase,mxsnal,sst1,hgtsub real(KIND=4),dimension(0:im+1,0:jm+1,nm)::msstt ! monthly sst logical(KIND=4):: lveg real(KIND=4):: vegfrm(0:im+1,0:jm+1,nm) ! monthly veg greeness !DRAGAN, August 2011 integer(KIND=4):: imo character(len=256)::green_mon character(len=2)::cn2 ! INTEGER(KIND=4) :: I5, I3, J3, I6, I7 integer(KIND=4),dimension(0:im+1,0:jm+1,nm)::lmh,lmv,ivgtyp,isltyp,islope real(KIND=4),dimension(0:im+1,0:jm+1,nm,lm)::htm,vtm real(KIND=4),dimension(0:im+1,0:jm+1,nm,4)::z0eff real(KIND=4),dimension(0:im+1,0:jm+1,nm,4)::smc,stc,sh2o real(KIND=4),dimension(0:im+1,0:jm+1,nm,4,2,2) ::& & qvh, qhv, qvh2, qhv2 real(KIND=4),dimension(0:im+1,0:jm+1,nm,8,2,2)::qintc1,qintc2 real(KIND=4),dimension(0:im+1,0:jm+1,nm,13,2,2)::qa real(KIND=4),dimension(0:im+1,0:jm+1,nm,2,2)::qb integer(KIND=4)::i2,j2,nd,ndays, nmonths,nmon,INDAY,IOUTNUM,IIOUT,IHRST character(len=4)::cn ! !GSM lvsst=.true. ! variable SST lvsst=.false. ! DRAGAN, August 2011 !lveg=.true. ! variable vegetation greeness lveg=.false. ! read(5,'(a)')init_out read(5,'(a)')mpi_out ! NAMELIST /CNSTDATA/INDAY,IHRST,IDAT,IOUTNUM,IIOUT ! open(19,file='cnstdata',status='old') READ(19,CNSTDATA) !-------------------- ! Output from "vrbls" !-------------------- list20 = 20 open(list20,file='init_out.dat',form ="unformatted") read(list20) pd, t, q, u, v, tg, smc, stc close(list20) !-------------------- ! Output from "const" !-------------------- list21 = 21 open(list21, file='dynam.dat',status='old',form ="unformatted") read(list21) fadv,fadv2, fadt, rd, f4d,f4q2, ef4t, fkin, deta, rdeta, aeta, eta, dfl, & daeta, wpdar, f11, f12, f21, f22, p11, p12, p21, p22, fcp, fdiv, fddmp, & hsinp,hcosp,delty,delthz,kappa,p0,rtdf,fvdiff,hbmsk close(list21) list22 = 22 open(list22, file='ctlblk.dat',status='old',form ="unformatted") read(list22) run,idat,ihrst,first,restrt,nfcst,nbc,list, & ntsd,nddamp,nprec,nboco,nshde,ncp, & subpost,ntddmp close(list22) ! print *,sigma,run,idat print *,im,jm,nm,lm print *,'dt,ntstm,',dt,ntstm,ntstm*dt/(3600*24) ! list23 = 23 open(list23, file='gridinit.dat',status='old',form ="unformatted") read(list23) sqv, sqh, q11, q12, q22,DXVDX, DXVDY, DYVDX, & DYVDY, DZVDX, DZVDY, RSQV, VCOSP, VSINP, VLAM, VPHI, RSQH, HCOSP, & HSINP, HLAM, HPHI,qd11,qd12,qd21,qd22,qvh,qhv,qbv11,qbv12,qbv22, & qvh2,qhv2,qh11,qh12,qh22,sqv_norm close(list23) ! list23 = 23 open(list23, file='zeff.dat',status='old',form ="unformatted") read(list23)z0eff close(list23) ! open(list21,file='hs.dat',status='old',form="unformatted") read(list21) kvdt, ktdt close(list21) ! open(1,file='sfceta2.dat',status='old',form='unformatted') read(1) sst, epsr, sm, sice, si, sno, vegfrc, ivgtyp, isltyp, islope, sh2o, albedo, albase, mxsnal ! OPEN(666,file="SICE_OUT4MPI.txt") WRITE(666,*) SICE CLOSE(666) ! close(1) ! ! open(2,file='sfceta.dat',status='old',form='unformatted') read(2) fis, res, htm, vtm, lmh, lmv close(2) open(21,file='qintc_2.dat',status='old',form='unformatted') read(21) qa read(21) qb close(21) ! related with the use of qintc.f90 or qintc_2.f90 !----------------------------------------------------------------------- mype = 0 do n=1,nm jmin = 0 do iy = 1,jym jmax = jmin + (jlm - 1) j1 = jmin imin = 0 do ix = 1,ixm imax = imin + (ilm -1) i1 = imin ! write(ftag, 100) mype 100 format(i4.4) !----------------------------------------------------------------------- filename='vrbls01.'//ftag !**** open(unit = 10, file=filename,form='unformatted') ! if (nm == 14) then call a2aloc(pd , i1, j1, n, 1, 10) call a2aloc(t , i1, j1, n, lm, 10) call a2aloc(q , i1, j1, n, lm, 10) call a2aloc(u , i1, j1, n, lm, 10) call a2aloc(v , i1, j1, n, lm, 10) call a2aloc(tg , i1, j1, n, 1, 10) else call a2al(pd , i1, j1, n, 1, 10) call a2al(t , i1, j1, n, lm, 10) call a2al(q , i1, j1, n, lm, 10) call a2al(u , i1, j1, n, lm, 10) call a2al(v , i1, j1, n, lm, 10) call a2al(tg , i1, j1, n, 1, 10) end if ! close(10) !----------------------------------------------------------------------- filename='const.'//ftag open(unit = 11, file=filename,form='unformatted') if (nm == 14) then call a2aloc(sqv , i1, j1, n, 1, 11 ) call a2aloc(sqh , i1, j1, n, 1, 11 ) call a2aloc(q11 , i1, j1, n, 1, 11 ) call a2aloc(q12 , i1, j1, n, 1, 11 ) call a2aloc(q22 , i1, j1, n, 1, 11 ) call a2aloc(qh11, i1, j1, n, 1, 11 ) call a2aloc(qh12, i1, j1, n, 1, 11 ) call a2aloc(qh22, i1, j1, n, 1, 11 ) ! do i=1,4 call a2aloc(qd11(:, :, :, i), i1, j1, n, 1, 11) call a2aloc(qd12(:, :, :, i), i1, j1, n, 1, 11) call a2aloc(qd21(:, :, :, i), i1, j1, n, 1, 11) call a2aloc(qd22(:, :, :, i), i1, j1, n, 1, 11) end do do i5=1,4 do i2=1,2 do j2=1,2 call a2aloc(qvh (:, :, :, i5, i2, j2), i1, j1, n, 1, 11) call a2aloc(qhv (:, :, :, i5, i2, j2), i1, j1, n, 1, 11) call a2aloc(qvh2(:, :, :, i5, i2, j2), i1, j1, n, 1, 11) call a2aloc(qhv2(:, :, :, i5, i2, j2), i1, j1, n, 1, 11) end do end do end do ! do i3=1,2 do j3=1,2 ! do i6=1,13 call a2aloc(qa(:, :, :, i6, i3, j3), i1, j1, n, 1, 11) end do ! call a2aloc(qb(:, :, :, i3, j3), i1, j1, n, 1, 11) end do end do ! call a2aloc (qbv11 , i1, j1, n, 1, 11 ) call a2aloc (qbv12 , i1, j1, n, 1, 11 ) call a2aloc (qbv22 , i1, j1, n, 1, 11 ) call a2aloc (wpdar , i1, j1, n, 1, 11 ) call a2aloc (f11 , i1, j1, n, 1, 11 ) call a2aloc (f12 , i1, j1, n, 1, 11 ) call a2aloc (f21 , i1, j1, n, 1, 11 ) call a2aloc (f22 , i1, j1, n, 1, 11 ) call a2aloc (p11 , i1, j1, n, 1, 11 ) call a2aloc (p12 , i1, j1, n, 1, 11 ) call a2aloc (p21 , i1, j1, n, 1, 11 ) call a2aloc (p22 , i1, j1, n, 1, 11 ) call a2aloc (fdiv , i1, j1, n, 1, 11 ) call a2aloc (fddmp , i1, j1, n, 1, 11 ) call a2aloc (hsinp , i1, j1, n, 1, 11 ) call a2aloc (hcosp , i1, j1, n, 1, 11 ) call a2aloc (hlam , i1, j1, n, 1, 11 ) call a2aloc (hphi , i1, j1, n, 1, 11 ) call a2aloc (fvdiff, i1, j1, n, 1, 11 ) call a2almskoc(hbmsk , i1, j1, n, 1, 11 ) else call a2al(sqv , i1, j1, n, 1, 11 ) call a2al(sqh , i1, j1, n, 1, 11 ) call a2al(q11 , i1, j1, n, 1, 11 ) call a2al(q12 , i1, j1, n, 1, 11 ) call a2al(q22 , i1, j1, n, 1, 11 ) call a2al(qh11 , i1, j1, n, 1, 11 ) call a2al(qh12 , i1, j1, n, 1, 11 ) call a2al(qh22 , i1, j1, n, 1, 11 ) call a2al(sqv_norm, i1, j1, n, 1, 11 ) ! do i5=1,4 call a2al(qd11(:, :, :, i5), i1, j1, n, 1, 11) call a2al(qd12(:, :, :, i5), i1, j1, n, 1, 11) call a2al(qd21(:, :, :, i5), i1, j1, n, 1, 11) call a2al(qd22(:, :, :, i5), i1, j1, n, 1, 11) end do ! do i3=1,4 do i2=1,2 do j2=1,2 call a2al(qvh (:, :, :, i3, i2, j2), i1, j1, n, 1, 11) call a2al(qhv (:, :, :, i3, i2, j2), i1, j1, n, 1, 11) call a2al(qvh2(:, :, :, i3, i2, j2), i1, j1, n, 1, 11) call a2al(qhv2(:, :, :, i3, i2, j2), i1, j1, n, 1, 11) end do end do end do ! do i2=1,2 do j2=1,2 ! do i7=1,13 call a2al(qa(:, :, :, i7, i2, j2), i1, j1, n, 1, 11) end do ! call a2al(qb(:, :, :, i2, j2), i1, j1, n, 1, 11) end do end do ! call a2al (qbv11 , i1, j1, n, 1, 11 ) call a2al (qbv12 , i1, j1, n, 1, 11 ) call a2al (qbv22 , i1, j1, n, 1, 11 ) call a2al (wpdar , i1, j1, n, 1, 11 ) call a2al (f11 , i1, j1, n, 1, 11 ) call a2al (f12 , i1, j1, n, 1, 11 ) call a2al (f21 , i1, j1, n, 1, 11 ) call a2al (f22 , i1, j1, n, 1, 11 ) call a2al (p11 , i1, j1, n, 1, 11 ) call a2al (p12 , i1, j1, n, 1, 11 ) call a2al (p21 , i1, j1, n, 1, 11 ) call a2al (p22 , i1, j1, n, 1, 11 ) call a2al (fdiv , i1, j1, n, 1, 11 ) call a2al (fddmp , i1, j1, n, 1, 11 ) call a2al (hsinp , i1, j1, n, 1, 11 ) call a2al (hcosp , i1, j1, n, 1, 11 ) call a2al (hlam , i1, j1, n, 1, 11 ) call a2al (hphi , i1, j1, n, 1, 11 ) call a2al (fvdiff, i1, j1, n, 1, 11 ) call a2almsk(hbmsk , i1, j1, n, 1, 11 ) end if ! write(11) deta, rdeta, aeta, daeta, eta, dfl, & fadv,fadv2, fadt, rd, pt, f4d, f4q2,ef4t, fkin,fcp,delty, & delthz,kappa,p0 ,rtdf ! write(11) dt, idat, ihrst, nfcst, nbc, list, iiout, ntsd, ntstm, & nddamp, nprec, idtad, nboco, nshde, ncp, nphs, & ncnvc, nrads, nradl, ntddmp, run, first, restrt, sigma, & subpost,lcornerm,outstr,ndassim,ndassimm ! close(11) ! filename='hs.'//ftag open(unit=12,file=filename,form='unformatted') write(12) kvdt call a2aloc(ktdt, i1, j1, n, lm, 12) close(12) ! filename='dgns.'//ftag open(unit=12,file=filename,form='unformatted') write(12) dgnnum, dgnstr, idgns, ickmm close(12) filename='sfceta3.'//ftag open(unit=12,file=filename,form='unformatted') ! if (nm == 14) then call a2aloc (fis , i1, j1, n, 1, 12) call a2aloc (res , i1, j1, n, 1, 12) call a2aloc (htm , i1, j1, n, lm, 12) call a2aloc (vtm , i1, j1, n, lm, 12) call a2aloci(lmh , i1, j1, n, 1, 12) call a2aloci(lmv , i1, j1, n, 1, 12) call a2aloc (sst , i1, j1, n, 1, 12) call a2aloc (epsr , i1, j1, n, 1, 12) call a2aloc (sm , i1, j1, n, 1, 12) call a2aloc (sice , i1, j1, n, 1, 12) call a2aloc (si , i1, j1, n, 1, 12) call a2aloc (sno , i1, j1, n, 1, 12) call a2aloc (vegfrc, i1, j1, n, 1, 12) call a2aloci(ivgtyp, i1, j1, n, 1, 12) call a2aloci(isltyp, i1, j1, n, 1, 12) call a2aloci(islope, i1, j1, n, 1, 12) call a2aloc (sh2o , i1, j1, n, 4, 12) call a2aloc (albedo, i1, j1, n, 1, 12) call a2aloc (albase, i1, j1, n, 1, 12) call a2aloc (mxsnal, i1, j1, n, 1, 12) call a2aloc (smc , i1, j1, n, 4, 12) call a2aloc (stc , i1, j1, n, 4, 12) call a2aloc (z0eff , i1, j1, n, 4, 12) ! call a2aloc(hgtsub,i1,j1,n,1,12) else call a2al (fis , i1, j1, n, 1, 12) call a2al (res , i1, j1, n, 1, 12) call a2al (htm , i1, j1, n, lm, 12) call a2al (vtm , i1, j1, n, lm, 12) call a2ali(lmh , i1, j1, n, 1, 12) call a2ali(lmv ,i1, j1, n, 1, 12) call a2al (sst , i1, j1, n, 1, 12) call a2al (epsr , i1, j1, n, 1, 12) call a2al (sm , i1, j1, n, 1, 12) call a2al (sice , i1, j1, n, 1, 12) call a2al (si , i1, j1, n, 1, 12) call a2al (sno , i1, j1, n, 1, 12) call a2al (vegfrc, i1, j1, n, 1, 12) call a2ali(ivgtyp, i1, j1, n, 1, 12) call a2ali(isltyp, i1, j1, n, 1, 12) call a2ali(islope, i1, j1, n, 1, 12) call a2al (sh2o , i1, j1, n, 4, 12) call a2al (albedo, i1, j1, n, 1, 12) call a2al (albase, i1, j1, n, 1, 12) call a2al (mxsnal, i1, j1, n, 1, 12) call a2al (smc , i1, j1, n, 4, 12) call a2al (stc , i1, j1, n, 4, 12) call a2al (z0eff , i1, j1, n, 4, 12) ! call a2al(hgtsub,i1,j1,n,1,12) end if ! close(12) ! filename='fcstdata.'//ftag open(unit=12,file=filename,form='unformatted') write(12) tprec, theat, tclod, trdsw, trdlw, tsrfc close(12) !====================================================================== !!!! DECOMPOSING MONTHLY SST (data set from December, 1981 - Jul, 2011) DRAGAN, August, 2011 !====================================================================== if(lvsst)then do M=416,421 write(cn,'(i4.4)') M monthlysst='/scratchout/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/initdata/monthly_sst'//cn//'.bin' open(33,file=monthlysst,form='unformatted',status='unknown',access='sequential') read(33) msstt close(33) monthlysst='/scratchout/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/initdata/monthly_sst'//cn//'.'//ftag open(44,file=monthlysst,form='unformatted',status='unknown',access='sequential') if(nm == 14) then call a2aloc(msstt, i1, j1, n, 1, 44) else call a2al (msstt, i1, j1, n, 1, 44) end if ! close(44) end do ! end if !=============================================================== !!!! DECOMPOSING MONTHLY VEG GREENESS DRAGAN, August, 2011 !=============================================================== if(lveg)then do imo=1,12 write(cn2,'(i2.2)') imo ! green_mon='VGREEN_12mon'//cn2//'.bin' green_mon='/scratchin/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/gef_trunk/PRP/data_in/init/VGREEN_12mon'//cn2//'.bin' open(55,file=green_mon,form='unformatted',status='unknown',access='sequential') read(55) vegfrm close(55) ! green_mon='VGREEN_12mon'//cn2//'.'//ftag green_mon='/scratchin/grupos/grpeta/projetos/tempo/oper/gef_v1.0.0/gef_trunk/PRP/data_in/init/VGREEN_12mon'//cn2//'.'//ftag open(66,file=green_mon,form='unformatted',status='unknown',access='sequential') if(nm.eq.14)then call a2aloc(vegfrm,i1,j1,n,1,66) else call a2al(vegfrm,i1,j1,n,1,66) endif enddo endif !----------------------------------------------------------------------- imin = imax mype = mype + 1 end do jmin = jmax end do end do !test filename='dgnsserver.dat' open(unit=12,file=filename,form='unformatted') write(12)ntstm,dgnnum,dgnstr,idgns close(12) !test print *,'FINISH DECOMPOSITION' !----------------------------------------------------------------------- end subroutine out4mpi_1