external/atm_ocn/atm_tiles.F

   1       SUBROUTINE ASSEMBLE(FG,FL,knd)
   2
   3       USE ATM_cc, ONLY: &
   4      &                  ids,idf,jds,jdf,kds,kde, &
   5      &                  ims,ime,jms,jme,kms,kme, &
   6      &                  its,ite,jts,jte,kts,kte
   7
   8       USE MODULE_PATCH_QUILT
   9
  10       implicit none
  11
  12       real,dimension(ids:idf,jds:jdf),intent(out):: FG
  13       real,dimension(ims:ime,jms:jme),intent(in) :: FL
  14       integer,                        intent(in) :: knd
  15
  16       integer kl,kg
  17 !
  18
  19       kl=kind(FL)
  20       kg=kind(FG)
  21       if (knd.ne.kl .or. knd.ne.kg) then
  22         print*,'knd must = loc. and glob. kinds in ASSEMBLE. '// &
  23      &  'To generalize, call of QUILT_2 must be generalized ',knd,kl,kg
  24         call GLOB_ABORT(1,'wrong kinds in ASSEMBLE',1)
  25       end if
  26
  27       call QUILT_2(FL,FG,ids,idf,jds,jdf,kds,kde, &
  28      &ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  29
  30       return
  31       END
  32 !
  33 !***********************************************************************
  34 !
  35       SUBROUTINE ASSEMBLE_R8(FG,FL,knd)
  36
  37       USE ATM_cc, ONLY: &
  38      &                  ids,idf,jds,jdf,kds,kde, &
  39      &                  ims,ime,jms,jme,kms,kme, &
  40      &                  its,ite,jts,jte,kts,kte
  41
  42       USE MODULE_PATCH_QUILT
  43
  44       implicit none
  45
  46       real(kind=8),dimension(ids:idf,jds:jdf),intent(out):: FG
  47       real(kind=8),dimension(ims:ime,jms:jme),intent(in) :: FL
  48       integer,                        intent(in) :: knd
  49
  50       integer kl,kg
  51 !
  52
  53       kl=kind(FL)
  54       kg=kind(FG)
  55       if (knd.ne.kl .or. knd.ne.kg) then
  56         print*,'knd must = loc. and glob. kinds in ASSEMBLE. '// &
  57      &  'To generalize, call of QUILT_2_R8 must be generalized ',knd,kl,kg
  58         call GLOB_ABORT(1,'wrong kinds in ASSEMBLE_R8',1)
  59       end if
  60
  61       call QUILT_2_R8(FL,FG,ids,idf,jds,jdf,kds,kde, &
  62      &ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  63
  64       return
  65       END
  66 !
  67 !***********************************************************************
  68 !
  69       SUBROUTINE DISASSEMBLE(FG,FL,knd)
  70
  71       USE ATM_cc, ONLY: ids,idf,jds,jdf,kds,kde, &
  72      &                  ims,ime,jms,jme,kms,kme, &
  73      &                  its,ite,jts,jte,kts,kte
  74
  75       USE MODULE_PATCH_QUILT
  76
  77       implicit none
  78
  79       real,dimension(ids:idf,jds:jdf),intent(in) :: FG
  80       real,dimension(ims:ime,jms:jme),intent(out):: FL
  81       integer,                        intent(in) :: knd
  82
  83       integer kl,kg
  84 !
  85
  86       kl=kind(FL)
  87       kg=kind(FG)
  88       if (knd.ne.kl .or. knd.ne.kg) then
  89         print*,'knd must = loc. and glob. kinds in DISASSEMBLE. '// &
  90      &  'To generalize, call of PATCH must be generalized ',knd,kl,kg
  91         call GLOB_ABORT(1,'whong kinds in DISASSEMBLE',1)
  92       end if
  93
  94       call PATCH(FG,FL,ids,idf,jds,jdf,kds,kde, &
  95      &ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  96
  97       return
  98       END