| PUMA 219 Portable University Model of the Atmosphere

- Main Page
- Data Types List
- Files

- File List
- File Members

/Users/home/WC/puma/src/mpimod_stub.f90
Go to the documentation of this file.

    00001 !     =======================================
    00002 !     mpimod_dummy.f90
    00003 !     ----------------
    00004 !     This module replaces <mpimod.f90> for
    00005 !     single CPU runs
    00006 !
    00007 !     The module is shared by PUMA and PlaSim
    00008 !     =======================================
    00009
    00010       subroutine mrdimensions
    00011       return
    00012       end
    00013
    00014       subroutine mrdiff(p,d,n)
    00015       real :: p(n)
    00016       real :: d(n)
    00017       return
    00018       end
    00019
    00020       subroutine mrsum(k) ! sum up 1 integer
    00021       return
    00022       end
    00023
    00024       subroutine mrbci(k) ! broadcast 1 integer
    00025       return
    00026       end
    00027
    00028       subroutine mpbci(k) ! broadcast 1 integer
    00029       return
    00030       end
    00031
    00032       subroutine mpbcin(k,n) ! broadcast n integer
    00033       integer :: k(n)
    00034       return
    00035       end
    00036
    00037       subroutine mpbcr(p) ! broadcast 1 real
    00038       return
    00039       end
    00040
    00041       subroutine mpbcrn(p,n) ! broadcast n real
    00042       real :: p(n)
    00043       return
    00044       end
    00045
    00046       subroutine mpbcl(k) ! broadcast 1 logical
    00047       logical :: k
    00048       return
    00049       end
    00050
    00051       subroutine mpscin(k,n) ! scatter n integer
    00052       integer :: k(n)
    00053       return
    00054       end
    00055
    00056       subroutine mpscrn(p,n) ! scatter n real
    00057       real :: p(n)
    00058       return
    00059       end
    00060
    00061       subroutine mpscdn(p,n) ! scatter n double precision
    00062       real (kind=8) :: p(n)
    00063       return
    00064       end
    00065
    00066       subroutine mpscsp(pf,pp,klev) ! scatter spectral fields
    00067       use pumamod
    00068       real pf(NESP,klev)
    00069       real pp(NSPP,klev)
    00070       pp(1:NSPP,1:klev) = pf(1:NSPP,1:klev)
    00071       return
    00072       end
    00073
    00074       subroutine mpscgp(pf,pp,klev) ! scatter gridpoint fields
    00075       use pumamod
    00076       real pf(NLON*NLAT,klev)
    00077       real pp(NHOR,klev)
    00078       pp(1:NHOR,1:klev) = pf(1:NHOR,1:klev)
    00079       return
    00080       end
    00081
    00082       subroutine mpgasp(pf,pp,klev) ! gather spectral fields
    00083       use pumamod
    00084       real pf(NESP,klev)
    00085       real pp(NSPP,klev)
    00086       pf(1:NSPP,1:klev) = pp(1:NSPP,1:klev)
    00087       return
    00088       end
    00089
    00090       subroutine mpgagp(pf,pp,klev) ! gather gridpoint fields
    00091       use pumamod
    00092       real pf(NHOR,klev)
    00093       real pp(NHOR,klev)
    00094       pf = pp
    00095       return
    00096       end
    00097
    00098       subroutine mpgacs(pcs) ! gather cross sections
    00099       return
    00100       end
    00101
    00102       subroutine mpgallsp(pf,pp,klev) ! gather spectral to all
    00103       use pumamod
    00104       real pf(NESP,klev)
    00105       real pp(NSPP,klev)
    00106       pf(1:NSPP,1:klev) = pp(1:NSPP,1:klev)
    00107       return
    00108       end
    00109
    00110       subroutine mpsum(psp,klev) ! sum spectral fields
    00111       return
    00112       end
    00113
    00114       subroutine mpsumsc(psf,psp,klev) ! sum & scatter spectral
    00115       use pumamod
    00116       real psf(NESP,klev)
    00117       real psp(NSPP,klev)
    00118       psp(1:NSPP,1:klev) = psf(1:NSPP,1:klev)
    00119       return
    00120       end
    00121
    00122       subroutine mpsumr(pr,kdim) ! sum kdim reals
    00123       return
    00124       end subroutine mpsumr
    00125
    00126       subroutine mpsumbcr(pr,kdim) ! sum & broadcast kdim reals
    00127       return
    00128       end
    00129
    00130       subroutine mpstart ! initialization
    00131       use pumamod
    00132       npro = 1
    00133       return
    00134       end
    00135
    00136       subroutine mpstop
    00137       return
    00138       end
    00139
    00140       subroutine mpreadsp(ktape,p,kdim,klev)
    00141       real p(kdim,klev)
    00142       read (ktape) p
    00143       return
    00144       end
    00145
    00146       subroutine mpreadgp(ktape,p,kdim,klev)
    00147       real p(kdim,klev)
    00148       read (ktape) p
    00149       return
    00150       end
    00151
    00152       subroutine mpwritesp(ktape,p,kdim,klev)
    00153       real p(kdim,klev)
    00154       write (ktape) p
    00155       return
    00156       end
    00157
    00158       subroutine mpwritegp(ktape,p,kdim,klev)
    00159       real p(kdim,klev)
    00160       write (ktape) p
    00161       return
    00162       end
    00163
    00164       subroutine mpwritegph(ktape,p,kdim,klev,ihead)
    00165       real :: p(kdim,klev)
    00166       integer :: ihead(8)
    00167       write (ktape) ihead
    00168       write (ktape) p
    00169
    00170       return
    00171       end
    00172
    00173
    00174       subroutine mpi_info(nprocess,pid)    ! get nproc and pid
    00175       integer nprocess, pid
    00176       nprocess = 1
    00177       pid = 0
    00178       return
    00179       end subroutine mpi_info
    00180
    00181
    00182       subroutine mpgetsp(yn,p,kdim,klev)
    00183       character (len=*) :: yn
    00184       real :: p(kdim,klev)
    00185       call get_restart_array(yn,p,kdim,kdim,klev)
    00186       return
    00187       end subroutine mpgetsp
    00188
    00189
    00190       subroutine mpgetgp(yn,p,kdim,klev)
    00191       character (len=*) :: yn
    00192       real :: p(kdim,klev)
    00193       call get_restart_array(yn,p,kdim,kdim,klev)
    00194       return
    00195       end subroutine mpgetgp
    00196
    00197
    00198       subroutine mpputsp(yn,p,kdim,klev)
    00199       character (len=*) :: yn
    00200       real :: p(kdim,klev)
    00201       call put_restart_array(yn,p,kdim,kdim,klev)
    00202       return
    00203       end subroutine mpputsp
    00204
    00205
    00206       subroutine mpputgp(yn,p,kdim,klev)
    00207       character (len=*) :: yn
    00208       real :: p(kdim,klev)
    00209       call put_restart_array(yn,p,kdim,kdim,klev)
    00210       return
    00211       end subroutine mpputgp
    00212
    00213
    00214 !      subroutine mpsurfgp(yn,p,kdim,klev)
    00215 !      character (len=*) :: yn
    00216 !      real :: p(kdim,klev)
    00217 !      call get_surf_array(yn,p,kdim,kdim,klev,iread)
    00218 !      return
    00219 !      end subroutine mpsurfgp
    00220 !
    00221 !
    00222 !      subroutine mpsurfyear(yn,p,kdim,kmon)
    00223 !      character (len=*) :: yn
    00224 !      real :: p(kdim,kmon)
    00225 !      call get_surf_year(yn,p,kdim,kmon,iread)
    00226 !      return
    00227 !      end subroutine mpsurfyear
    00228 !
    00229 !
    00230 !      subroutine mp3dyear(yn,p,kdim,klev,kmon)
    00231 !      character (len=*) :: yn
    00232 !      real :: p(kdim,klev,kmon)
    00233 !      call get_3d_year(yn,p,kdim,klev,kmon,iread)
    00234 !      return
    00235 !      end subroutine mp3dyear
    00236
    00237
    00238       subroutine mpmaxval(p,kdim,klev,pmax)
    00239       real :: p(kdim,klev)
    00240       pmax = maxval(p(:,:))
    00241       return
    00242       end subroutine mpmaxval
    00243
    00244
    00245       subroutine mpsumval(p,kdim,klev,psum)
    00246       real :: p(kdim,klev)
    00247       psum = sum(p(:,:))
    00248       return
    00249       end subroutine mpsumval
    00250