File: C:\NOAA\NEMS_11731\src\atmos\gfs\phys\atm.comm.f

1           MODULE constant_cc
2     
3           USE MACHINE, ONLY: kind_phys
4     
5           USE physcons
6     
7           END MODULE constant_cc
8     !
9     !***********************************************************************
10     !
11           MODULE ATM_cc
12     
13           USE CMP_COMM, ONLY:
14          >   MPI_COMM_Atmos => COMM_local,
15          >   Coupler_id,
16          >   component_master_rank_local,
17          >   process_rank_local,
18     !          Note: the latter two are only to compare with each
19     !          other and thus determine if the process is the local
20     !          master (root) process. (Comparison of
21     !          component_master_rank_global with process_rank_global
22     !          would not work because the former is known only to
23     !          Coupler process and the local master process itself.)
24          >   component_nprocs,
25          >   kind_REAL,MPI_kind_REAL,
26          >   MPI_INTEGER,MPI_STATUS_SIZE,
27          >   ibuffer
28           USE mpi_def, ONLY: COMM_TILES => MC_COMP
29           USE layout1, ONLY: TILES_nprocs => nodes_comp
30     
31           implicit none
32     
33           integer latg,latr,lonf,lonr
34           integer latd
35           integer lats_node_r,ipt_lats_node_r
36     
37           integer N2D
38     
39           integer, allocatable:: global_lats_r(:),lonsperlar(:)
40     
41           logical COMP /.false./
42     
43     !controls:
44     !     integer nunit_announce_cc /6/, VerbLev /5/
45     !     integer nunit_announce_cc /6/, VerbLev /2/
46           integer nunit_announce_cc /6/, VerbLev /1/
47     
48           save
49     
50           END MODULE ATM_cc
51     !
52     !***********************************************************************
53     !
54           MODULE SURFACE_cc
55     
56           USE constant_cc, ONLY:
57          >           hvap_cc=>con_hvap,         ! - this is L, to use in LE
58                                                 ! Check: if L in LE must
59                                                 ! rather be either evap.
60                                                 ! heat or evap.+melt. heat
61          >           JCAL_cc=>con_JCAL,         ! - J in Cal
62          >           kind_phys_cc=>kind_phys
63     
64           implicit none
65     
66           integer, parameter:: 
67          >           kind_sfcflux=8,
68          >           kind_SST=8,
69          >           kind_SLMSK=8,
70          >           kind_OROGR=8,
71          >           kind_dt_cc=8,              !-->cpl insertion: add model vars precision here <--
72          >           kind_modelvar=8
73     
74           integer,allocatable:: ISLM_RG(:,:),ISLM_FG(:,:)
75           real (kind=kind_sfcflux),allocatable:: 
76          >DUSFC_cc(:,:),DVSFC_cc(:,:),
77          >DTSFC_cc(:,:),DQSFC_cc(:,:),PRECR_cc(:,:),
78          >DLWSFC_cc(:,:),ULWSFC_cc(:,:),SWSFC_cc(:,:),
79     !-->cpl insertion
80          >XMU_cc(:,:),DSW_cc(:,:),DLW_cc(:,:),ffmm_cc(:,:),ffhh_cc(:,:),
81          >SNW_cc(:,:),LPREC_cc(:,:),SST_ave(:,:)
82     !<--cpl insertion
83     
84           real (kind=kind_SST),allocatable:: SST_cc(:,:)
85     
86           real (kind=kind_dt_cc) dt_cc,dto_cc         !-->cpl insertion: add dto_cc
87     
88     !--> cpl insertion: add model vars here:
89           real (kind=kind_modelvar),allocatable::
90          >   T_BOT_cc(:,:),U_BOT_cc(:,:),V_BOT_cc(:,:), Q_BOT_cc(:,:), 
91          >   P_BOT_cc(:,:),P_SURF_cc(:,:),Z_BOT_cc(:,:),T_SFC_cc(:,:)
92          &,  FICE_SFC_cc(:,:), HICE_SFC_cc(:,:)
93     !<-- cpl insertion
94     
95           logical lssav_cc,lsout_cc,lgetSSTICE_cc,l_df_cc
96     !--> cpl insertion
97           logical lsout_cc_momice,lsout_cc_momocn
98           integer i_dto2dta_cc
99     !<-- cpl insertion
100           integer i_dtc2dta_cc
101     !     parameter (i_dtc2dta_cc=3) ! <- ratio of time steps in OM and AM
102           real (kind=kind_dt_cc) dta2dtc_cc,dta2dto_cc
103     
104           real(kind=kind_phys_cc) CONVRAD_cc
105           PARAMETER (CONVRAD_cc=JCAL_cc*1.E4/60.) ! - see progtmr.f,
106                                                   ! subr. progtm
107     
108           integer n_do_tstep_cc /0/,kdtmax_cc/0/
109     
110           character*180 s_cc
111     
112           integer ISLM_OS_value,ISLM_SI_value,ISLM_L_value
113           parameter (ISLM_OS_value=0,
114                       !<- must be integer open sea value in AM sea/land mask
115          >           ISLM_L_value=1,
116                       !<- must be integer land value in AM sea/land mask
117          >           ISLM_SI_value=2)
118                       !<- must be integer sea ice value in AM sea/land mask
119     
120           real SLM_OS_value,unrealistically_low_SST,
121          >unrealistically_low_SV,unrealistically_low_SVp
122          >,unrealistically_low_SF
123           parameter (unrealistically_low_SST=0.01,
124                                ! <- must be unreal low but >=0., see
125                                ! subr. O2A --- check!
126          >     unrealistically_low_SV=-1.E30)
127                                ! <- must be negative unreal low surface flux
128                                ! or other surface value to be sent
129                                ! to Coupler, see Coupler code
130           parameter (SLM_OS_value=REAL(ISLM_OS_value),
131                        ! <- must be real open sea value in AM
132                        ! sea/land mask array 
133          >           unrealistically_low_SVp=0.99*unrealistically_low_SV,
134          >               unrealistically_low_SF=unrealistically_low_SV)
135                             !<- this used to be the name of the value; it
136                             ! is not used any more but may be referred to
137                             ! in comments
138     
139           save
140     
141           END MODULE SURFACE_cc
142     !
143     !***********************************************************************
144     !
145           SUBROUTINE ATM_CMP_START
146     
147           USE ATM_cc, ONLY: component_nprocs,VerbLev,ibuffer,Coupler_id
148     
149           implicit none
150     
151           integer Atmos_id /1/, Atmos_master_rank_local /0/
152           character*20 s
153     !
154     
155     !        print*,'AM: to call CMP_INIT'
156                           !<-id of AM as a component of the coupled system
157           call CMP_INIT(Atmos_id,1)
158                                  !<-"flexibility level"
159     !        print*,'AM: back from CMP_INIT'
160     !      if (Coupler_id.ge.0) VerbLev=min(VerbLev,ibuffer(4))
161           if (Coupler_id.ge.0) VerbLev=min(VerbLev,2)
162     
163             Atmos_master_rank_local=component_nprocs-1
164                                    !<- this redefinition is to meet the
165                                    ! requirement of subr. split2d_r used
166                                    ! in DISASSEMBLE_cc for disassembling
167                                    ! 2D fields. The requirement seems
168                                    ! to be that the input argument
169                                    ! representing a whole grid array be
170                                    ! defined in process of the largest rank
171                                    ! which seems to be considered i/o
172                                    ! process. To use a different value,
173                                    ! e.g. the conventional 0, split2d_r
174                                    ! (or DISASSEMBLE_cc) must be rewritten.
175                          ! (Strangely, unsplit2d_r does not pose this
176                          ! requirement and uses a dummy arg. ioproc to
177                          ! identify the process where the whole grid array
178                          ! is to be defined. Seemingly.)
179     
180           Atmos_master_rank_local=0  ! see above for modifications needed
181                                      ! to support this change
182     
183           call CMP_INTRO(Atmos_master_rank_local)
184     
185           write(s,'(i2)') VerbLev
186           call ATM_ANNOUNCE('back from CMP_INTRO, VerbLev='//s,2)
187     
188           return
189           END
190     !
191     !***********************************************************************
192     !
193           SUBROUTINE ATM_CMP_START1
194     
195           USE ATM_cc, ONLY: process_rank_local,VerbLev,ibuffer,Coupler_id
196     
197           implicit none
198     
199           integer Atmos_id /1/
200     !
201     
202                           !<-id of AM as a component of the coupling system
203           call CMP_INIT(Atmos_id,1)
204                                  !<-"flexibility level"
205     
206     !      if (Coupler_id.ge.0) VerbLev=min(VerbLev,ibuffer(4))
207           if (Coupler_id.ge.0) VerbLev=min(VerbLev,2)
208     
209     !           print*,'AM: back from CMP_INIT, process_rank_local=',
210     !    >      process_rank_local
211     
212           return
213           END
214     !
215     !***********************************************************************
216     !
217           SUBROUTINE ATM_CMP_START2(me)      
218     
219           USE ATM_cc, ONLY: VerbLev
220     
221           implicit none
222     
223           integer me
224     
225           character*20 s
226     !
227     
228           if (me .eq. 0) then
229             CALL CMP_INTRO_m
230           else
231             CALL CMP_INTRO_s
232           end if
233     
234           write(s,'(i2)') VerbLev
235           call ATM_ANNOUNCE('back from CMP_INTRO_m, VerbLev='//s,1)
236     
237           return
238           END
239     !
240     !***********************************************************************
241     !
242           SUBROUTINE ATM_TILES_INIT(lonr_dummy,latr_dummy,lonf_dummy,
243          >latg_dummy,latd_dummy,ipt_lats_node_r_dummy,
244          >global_lats_r_dummy,lonsperlar_dummy)
245     
246           USE ATM_cc
247     
248           implicit none
249     
250           integer lonr_dummy,latr_dummy,lonf_dummy,latg_dummy,latd_dummy
251           integer ipt_lats_node_r_dummy
252           integer global_lats_r_dummy(latr_dummy),
253          >        lonsperlar_dummy(latr_dummy)
254     
255           character*10 s
256     !
257     
258           lonr=lonr_dummy
259           latr=latr_dummy
260           lonf=lonf_dummy
261           latg=latg_dummy
262           latd=latd_dummy
263           lats_node_r=latd
264           ipt_lats_node_r=ipt_lats_node_r_dummy
265     
266           N2D=lonf*latg
267     
268           write(s,'(i5)') lonr
269           CALL ATM_ANNOUNCE('ATM_TILES_INIT: lonr='//s,2)
270           write(s,'(i5)') latr
271           CALL ATM_ANNOUNCE('ATM_TILES_INIT: latr='//s,2)
272           write(s,'(i5)') lonf
273           CALL ATM_ANNOUNCE('ATM_TILES_INIT: lonf='//s,2)
274           write(s,'(i5)') latg
275           CALL ATM_ANNOUNCE('ATM_TILES_INIT: latg='//s,2)
276           write(s,'(i5)') latd
277           CALL ATM_ANNOUNCE('ATM_TILES_INIT: latd='//s,2)
278     
279           call GLOB_ABORT(abs(lonr-lonf)+abs(latr-latg),
280          >'Unexpected: lonr, lonf or latr, latg differ. Aborting',1)
281     
282           if (.not. allocated(global_lats_r)) allocate(global_lats_r(latr))
283           if (.not. allocated(lonsperlar))    allocate(lonsperlar(latr))
284           global_lats_r=global_lats_r_dummy
285           lonsperlar=lonsperlar_dummy
286     
287           CALL ATM_ANNOUNCE(
288          >'ATM_TILES_INIT: global_lats_r, lonsperlar assigned',2)
289           if (VerbLev.ge.2) then
290             print*,'AM: ATM_TILES_INIT',component_master_rank_local,
291          >  ' ipt_lats_node_r=',ipt_lats_node_r,' latd=',latd
292             print*,'AM: ATM_TILES_INIT',component_master_rank_local,
293          >  ' global_lats_r: ',global_lats_r
294             print*,'AM: ATM_TILES_INIT',component_master_rank_local,
295          >  ' lonsperlar: ',lonsperlar
296           end if
297     
298           call INITIALIZE_TILING
299     
300           return
301           END
302     !
303     !***********************************************************************
304     !
305           SUBROUTINE ATM_SURF_INIT
306     
307           USE ATM_cc, ONLY: lonr,latd,lonf,latg
308     
309           USE SURFACE_cc
310     
311           implicit none
312     
313           integer rc
314     C
315     
316           write(s_cc,'(4i5)') lonr,latd,lonf,latg
317           CALL ATM_ANNOUNCE(
318          >'ATM_SURF_INIT: lonr,latd,lonf,latg: '//s_cc,2)
319     !--> cpl insertion
320           if (.not. allocated(T_BOT_cc))    allocate(T_BOT_cc(lonr,latd))
321           if (.not. allocated(U_BOT_cc))    allocate(U_BOT_cc(lonr,latd))
322           if (.not. allocated(V_BOT_cc))    allocate(V_BOT_cc(lonr,latd))
323           if (.not. allocated(Q_BOT_cc))    allocate(Q_BOT_cc(lonr,latd))
324           if (.not. allocated(P_BOT_cc))    allocate(P_BOT_cc(lonr,latd))
325           if (.not. allocated(Z_BOT_cc))    allocate(Z_BOT_cc(lonr,latd))
326           if (.not. allocated(P_SURF_cc))   allocate(P_SURF_cc(lonr,latd))
327           if (.not. allocated(T_SFC_cc))    allocate(T_SFC_cc(lonr,latd))
328           if (.not. allocated(FICE_SFC_cc)) allocate(FICE_SFC_cc(lonr,latd))
329           if (.not. allocated(HICE_SFC_cc)) allocate(HICE_SFC_cc(lonr,latd))
330           if (.not. allocated(XMU_cc))      allocate(XMU_cc(lonr,latd))
331           if (.not. allocated(DSW_cc))      allocate(DSW_cc(lonr,latd))
332           if (.not. allocated(DLW_cc))      allocate(DLW_cc(lonr,latd))
333           if (.not. allocated(ffmm_cc))     allocate(ffmm_cc(lonr,latd))
334           if (.not. allocated(ffhh_cc))     allocate(ffhh_cc(lonr,latd))
335     !
336     !     allocate(T_BOT_cc(lonr,latd),U_BOT_cc(lonr,latd),
337     !    >     V_BOT_cc (lonr,latd),Q_BOT_cc(lonr,latd),
338     !    >     P_BOT_cc (lonr,latd),P_SURF_cc(lonr,latd),
339     !    >     Z_BOT_cc (lonr,latd),
340     !    >     T_SFC_cc (lonr,latd),
341     !    >     FICE_SFC_cc (lonr,latd),HICE_SFC_cc (lonr,latd),
342     !    >     XMU_cc(lonr,latd),
343     !    >     DSW_cc(lonr,latd), DLW_cc(lonr,latd),
344     !    >     ffmm_cc(lonr,latd), ffhh_cc(lonr,latd) )
345     !
346           T_BOT_cc=0.
347           U_BOT_cc=0.
348           V_BOT_cc=0.
349           Q_BOT_cc=0.
350           P_BOT_cc=0.
351           P_SURF_cc=0.
352           Z_BOT_cc=0.
353           T_SFC_cc=0.
354           FICE_SFC_cc=0.
355           HICE_SFC_cc=0.
356           XMU_cc=0.
357           DSW_cc=0.
358           DLW_cc=0.
359           ffmm_cc=0.
360           ffhh_cc=0.
361     !<-- cpl insertion
362     
363           if (.not. allocated(DUSFC_cc))  allocate(DUSFC_cc(lonr,latd))
364           if (.not. allocated(DVSFC_cc))  allocate(DVSFC_cc(lonr,latd))
365           if (.not. allocated(DTSFC_cc))  allocate(DTSFC_cc(lonr,latd))
366           if (.not. allocated(DQSFC_cc))  allocate(DQSFC_cc(lonr,latd))
367           if (.not. allocated(PRECR_cc))  allocate(PRECR_cc(lonr,latd))
368           if (.not. allocated(SST_cc))    allocate(SST_cc(lonr,latd))
369           if (.not. allocated(DLWSFC_cc)) allocate(DLWSFC_cc(lonr,latd))
370           if (.not. allocated(ULWSFC_cc)) allocate(ULWSFC_cc(lonr,latd))
371           if (.not. allocated(SWSFC_cc))  allocate(SWSFC_cc(lonr,latd))
372           if (.not. allocated(SST_ave))   allocate(SST_ave(lonr,latd))
373           if (.not. allocated(SNW_cc))    allocate(SNW_cc(lonr,latd))
374           if (.not. allocated(LPREC_cc))  allocate(LPREC_cc(lonr,latd))
375     !
376     !     allocate(DUSFC_cc(lonr,latd),DVSFC_cc(lonr,latd),
377     !    >     DTSFC_cc (lonr,latd),DQSFC_cc(lonr,latd),
378     !    >     PRECR_cc(lonr,latd),SST_cc(lonr,latd),
379     !    >     DLWSFC_cc(lonr,latd),ULWSFC_cc(lonr,latd),
380     !    >     SWSFC_cc(lonr,latd) ,SST_ave(lonr,latd),
381     !    >     SNW_cc(lonr,latd), LPREC_cc(lonr,latd) )     
382     
383           DUSFC_cc=0.
384           DVSFC_cc=0.
385           DTSFC_cc=0.
386           DQSFC_cc=0.
387           PRECR_cc=0.
388           SNW_cc=0.
389           LPREC_cc=0.
390           DLWSFC_cc=0.
391           ULWSFC_cc=0.
392           SWSFC_cc=0.
393           SST_ave=0.
394     
395           if (.not. allocated(ISLM_RG)) allocate(ISLM_RG(lonr,latd))
396           if (.not. allocated(ISLM_FG)) allocate(ISLM_FG(lonr,latd))
397     !
398     !     allocate(ISLM_RG(lonr,latd),ISLM_FG(lonr,latd))
399     
400           call ATM_ANNOUNCE('ATM_SURF_INIT: ISLM_RG, ISLM_FG allocated',1)
401     
402           if (kind_sfcflux.ne.kind_phys_cc) then
403             print*,'ATM_SURF_INIT: kind_sfcflux, kind_phys: ',
404          >  kind_sfcflux, kind_phys_cc
405             call GLOB_ABORT(1,'kind_sfcflux.ne.kind_phys_cc, GBPHYS args'//
406          >  ' must be redeclared and code adjustments made',rc)
407           end if
408     
409           return
410           END
411     !
412     !***********************************************************************
413     !
414           SUBROUTINE ATM_RECVdtc(dta)
415     
416           USE ATM_cc, ONLY:
417          >   MPI_COMM_Atmos,
418          >   Coupler_id,
419          >   component_master_rank_local,
420          >   kind_REAL,MPI_kind_REAL
421     
422           USE SURFACE_cc, ONLY:
423          >dt_cc,dta2dtc_cc,i_dtc2dta_cc,i_dto2dta_cc,
424          >s_cc , dto_cc,dta2dto_cc                  !--> cpl insertion: add dto_cc, dta2dto_cc
425     
426           implicit none
427     
428           real dta
429           real (kind=kind_REAL) buf(2)
430           integer rc,sizebuf
431           character*40 s
432     
433           call ATM_ANNOUNCE('ATM_RECVdtc: to receive C time step',2)
434           buf=0.
435           sizebuf=size(buf)
436           call CMP_RECV(buf,sizebuf)
437           if (Coupler_id.lt.0) then
438             dt_cc=0.
439             dto_cc=0.
440             call ATM_ANNOUNCE(
441          >  'ATM_RECVdtc: C time step assigned 0, as it is standalone mode'
442          >  ,2)
443           else
444             write(s,'(e20.12,e20.12)') buf(1),buf(2)
445             call ATM_ANNOUNCE(
446          >  'ATM_RECVdtc: C time step ='//trim(s)//' received',2)
447             call MPI_BCAST(buf,2,MPI_kind_REAL,
448          >  component_master_rank_local,MPI_COMM_Atmos,rc)
449             call ATM_ANNOUNCE('ATM_RECVdtc: C time step broadcast',2)
450             dt_cc=buf(1)
451             dto_cc=buf(2)
452           end if
453     
454           i_dtc2dta_cc = dt_cc/dta  + 0.001
455           i_dto2dta_cc = dto_cc/dta + 0.001
456     
457           print *,' dto_cc=',dto_cc,' dta=',dta,' i_dto2dta_cc=',
458          & i_dto2dta_cc,' dt_cc=',dt_cc,' i_dtc2dta_cc=',i_dtc2dta_cc
459     
460           if (i_dtc2dta_cc.eq.0) then
461             i_dtc2dta_cc=4
462             call ATM_ANNOUNCE('ratio of OM/AM time steps =0, assigned 4 .'//
463          >  ' This should only occur if it is standalone mode',2)
464           else
465             write(s_cc,'(i2,i2)') i_dtc2dta_cc,i_dto2dta_cc
466     !       print *,' s_cc=',s_cc
467             call ATM_ANNOUNCE('ratio of OM/AM time steps: '//trim(s_cc),2)
468           end if
469           dta2dtc_cc=1./i_dtc2dta_cc
470           dta2dto_cc=1./i_dto2dta_cc
471     
472           RETURN
473           END
474     !
475     !***********************************************************************
476     !
477           SUBROUTINE ATM_SENDGRID(XLON,XLAT)
478     
479           USE ATM_cc
480     
481           implicit none
482     
483           real (kind=kind_REAL) XLON(lonr,latd),XLAT(lonr,latd)
484           real (kind=kind_REAL) ALON(lonf),ALAT(latg),
485          >x(lonf,latg),y(lonf,latg)
486     
487           integer buf(2),i,j
488     
489           logical fg
490     
491           character*50 s
492           
493           if (Coupler_id.lt.0) return    !   <- standalone mode
494     
495           buf(1)=lonf
496           buf(2)=latg
497           call ATM_ANNOUNCE('to send grid dimensions',1)
498           call CMP_INTEGER_SEND(buf,2)
499           call ATM_ANNOUNCE('grid dimensions sent',1)
500     
501           call ASSEMBLE_cc(x,XLON)
502     
503     !-->cpl deletion, mom4, do not need laon, alat
504     !      if (component_master_rank_local.eq.process_rank_local) then
505     !
506     !c       ALON=x(:,1)
507     !        ALON=x(:,latg/2) ! assigns closest to equator lat. circle,
508     !                         ! where in reduced grid numb. of longitudes
509     !                         ! is maximal and = that in full grid
510     !
511     !        fg=.true.
512     !        do j=1,latg
513     !        do i=1,lonf
514     !          if (ALON(i).ne.x(i,j)) then
515     !            fg=.false.
516     !            write(s,'(2i5,1p2e16.7)') j,i,ALON(i),x(i,j)
517     !c           call GLOB_ABORT(1,
518     !            call ATM_ANNOUNCE(
519     !     >      'ATM_SENDGRID: inhomogeneous longitudes'//s,2)
520     !            exit
521     !          end if
522     !        end do
523     !        end do
524     !        if (fg) then
525     !          call ATM_ANNOUNCE('ATM_SENDGRID: full grid',1)
526     !        else
527     !          call ATM_ANNOUNCE('ATM_SENDGRID: reduced grid',1)
528     !        end if
529     !
530     !        call ATM_ANNOUNCE('to send array of longitudes',1)
531     !        call CMP_SEND(ALON,lonf)
532     !        call ATM_ANNOUNCE('array of longitudes sent',1)
533     !
534     !      end if
535     !<-- cpl deletion
536      
537           call ASSEMBLE_cc(x,XLAT)
538     
539     !-->cpl deletion, mom4, do not need laon, alat
540     !      if (component_master_rank_local.eq.process_rank_local) then
541     !
542     !        ALAT=x(1,:)
543     !
544     !        do j=1,latg
545     !          if (ALAT(j).ne.x(2,j)) then
546     !            write(s,'(i5,1p2e16.7)') j,ALAT(j),x(2,j)
547     !            call GLOB_ABORT(1,
548     !     >      'ATM_SENDGRID: inhomogenous latitudes, aborting'//s,1)
549     !          end if
550     !        end do
551     !
552     !        call ATM_ANNOUNCE('to send array of latitudes',1)
553     !        call CMP_SEND(ALAT,latg)
554     !        call ATM_ANNOUNCE('array of latitudes sent',1)
555     !
556     !      end if
557     !<-- cpl deletion
558     
559           return
560           END
561     !
562     !***********************************************************************
563     !
564           SUBROUTINE ATM_SENDSLM(SLMSK)
565     !
566     !        This is to send sea/land mask with 0. on sea (either open sea
567     !        or sea ice) and 1. on land. For the assumptions about SLMSK
568     !        argument, see code/comments below
569     
570           USE ATM_cc
571     
572           USE SURFACE_cc, ONLY: ISLM_RG,ISLM_FG,kind_SLMSK
573     
574           implicit none
575     
576           real (kind=kind_SLMSK) SLMSK(lonr,latd)
577     
578           real(kind=kind_REAL), dimension(lonr,latd):: SLM1,SLM2,SLM0
579           real SLM(lonf,latg)
580           integer i,j,lat,lons
581           character*80 s
582           logical bad_SLM /.false./
583     
584           if (Coupler_id.lt.0) return    !   <- standalone mode
585     
586           if (VerbLev.ge.2) then
587              print*,'ATMSENDSLM entered, lonr,latd,lonf,latg: ',
588          >   lonr,latd,lonf,latg
589           end if
590     
591           do j=1,latd
592           do i=1,lonr
593             if (abs(SLMSK(i,j)-2.).lt.1.E-5              ! sea ice
594          >      .or. abs(SLMSK(i,j)).lt.1.E-5) then      ! open sea
595               SLM1(i,j)=0.
596             else if (abs(SLMSK(i,j)-1.).lt.1.E-5) then   ! land
597               SLM1(i,j)=1.
598             else
599               SLM1(i,j)=666.
600             end if
601           end do
602           end do
603     
604           ISLM_RG=nint(SLM1)
605                 !<- store reduced grid integer mask array for future
606                 ! communications; it will only be needed for uninterpred_cc
607     
608     !        print*,'ATMSENDSLM to call uninterpred_cc'
609     
610           call uninterpred_cc(1,ISLM_RG,SLM1,SLM2)
611                       ! <- interpolation FROM reduced grid (i.e. with # of
612                       ! longitudes varying from lat. circle to lat. circle)
613                       ! to full grid. 
614     
615     !        print*,'ATMSENDSLM back from uninterpred_cc'
616     
617             ! Because 1st arg. iord=1, ISLM_RG values do not matter here, it
618             ! is just a dummy input argument with proper type/dimensions.
619             ! Reduced grid mask SLM1 is interpolated to full grid mask
620             ! SLM2 (both arrays are local (per process)) by taking the
621             ! nearest value on the lat. circle. This procedure should be
622             ! reversible.
623     ! Reversibility test:->
624     
625     !        print*,'ATMSENDSLM to call interpred_cc'
626     
627           call interpred_cc(1,ISLM_FG,SLM2,SLM0)
628                                !<- same thing: ISLM_FG values don't matter.
629                                ! And they are undefined here.
630     
631     !        print*,'ATMSENDSLM back from interpred_cc'
632     
633           do j=1,latd
634             lat=global_lats_r(ipt_lats_node_r-1+j)
635             lons=lonsperlar(lat)
636             do i=1,lons
637               if (SLM0(i,j).ne.SLM1(i,j)) then
638                 write(s,'("SLM: R2F irreversible",2i6,2pe17.9)')
639          >      i,j,SLM1(i,j),SLM0(i,j)
640                 bad_SLM=.true.
641                 exit
642               end if
643             end do
644           end do
645     ! <-: reversibility test
646     
647     !        print*,'ATMSENDSLM finished reversibility test'
648     
649     ! Value test:->
650           do j=1,latd
651           do i=1,lonr
652             if (SLM2(i,j).ne.0. .and. SLM2(i,j).ne.1.) then
653               write(s,'("Bad SLM value",2i6,1pe20.12)') i,j,SLM2(i,j)
654               bad_SLM=.true.
655               exit
656             end if
657           end do
658           end do
659     ! <-: value test
660     
661     !        print*,'ATMSENDSLM finished value test'
662     
663           if (bad_SLM) then
664             call GLOB_ABORT(1,'ATM_SENDSLM: '//s,1)
665           end if
666     
667     !        print*,'ATMSENDSLM to assign ISLM_FG=nint(SLM2)'
668     
669     
670           ISLM_FG=nint(SLM2)
671                 !<- store full grid integer mask array for future
672                 ! communications; it will only be needed for interpred_cc
673     
674     !        print*,'ATMSENDSLM to call ASSEMBLE_cc'
675     
676     
677           call ASSEMBLE_cc(SLM,SLM2)
678     
679     !        print*,'ATMSENDSLM back from ASSEMBLE_cc'
680     
681     !--> cpl deletion
682     !d      call CMP_SEND(SLM,N2D)
683     !<-- cpl deletion
684     
685     !        print*,'ATMSENDSLM to return'
686     
687     
688           return
689           END
690     !
691     !***********************************************************************
692     !
693           SUBROUTINE ATM_GETSSTICE
694          >(TSEA,TISFC,FICE,HICE,SHELEG,SLMSK,OROGR,kdt)
695     
696           USE ATM_cc, ONLY: kind_REAL,lonr,latd,Coupler_id,N2D,latg,lonf
697     
698           USE SURFACE_cc, ONLY:
699          > lgetSSTICE_cc,kind_SST,kind_SLMSK,kind_OROGR,ISLM_FG,
700          >SST_cc, SLM_OS_value,unrealistically_low_SST,
701          >SST_ave,lsout_cc_momocn,dta2dto_cc,i_dto2dta_cc
702     
703           implicit none
704     
705           integer kdt
706           real (kind=kind_SST),dimension(lonr,latd),intent(inout) :: TSEA,
707          >   TISFC, FICE, HICE, SHELEG
708           real,dimension(:,:),allocatable :: FICE_cc,HICE_cc,
709          >    HSNO_cc
710           real (kind=kind_SLMSK) SLMSK(lonr,latd)
711           real (kind=kind_OROGR) OROGR(lonr,latd)
712     
713           logical RECV
714     
715           real, PARAMETER:: RLAPSE=0.65E-2
716           real, PARAMETER:: CIMIN=0.15, HIMIN=0.10, HIMAX=8.0, TFW=271.2
717           real, PARAMETER:: DS=330.0
718     
719           integer i,j
720     !
721     
722           RECV=lgetSSTICE_cc
723     
724           allocate(FICE_cc(lonr,latd),HICE_cc(lonr,latd),
725          >  HSNO_cc(lonr,latd) )
726     
727           if (RECV) then
728             call ATM_ANNOUNCE('ATM_GETSSTICE: to receive SST',2)
729             call ATM_TILES_RECV(SST_cc,fval=unrealistically_low_SST,iord=2)
730             call ATM_ANNOUNCE('ATM_GETSSTICE: SST received',2)
731     
732     !
733             call ATM_ANNOUNCE('ATM_GETSSTICE: to receive FICE',2)
734             call ATM_TILES_RECV(FICE_cc,iord=2)
735             call ATM_ANNOUNCE('ATM_GETSSTICE: FICE received',2)
736     !       print *,'after recv FICE'
737     
738             call ATM_ANNOUNCE('ATM_GETSSTICE: to receive HICE',2)
739             call ATM_TILES_RECV(HICE_cc,iord=2)
740             call ATM_ANNOUNCE('ATM_GETSSTICE: HICE received',2)
741     !       print *,'after recv HICE'
742     
743             call ATM_ANNOUNCE('ATM_GETSSTICE: to receive HSNO',2)
744             call ATM_TILES_RECV(HSNO_cc,iord=2)
745             call ATM_ANNOUNCE('ATM_GETSSTICE: HSNO received',2)
746     !       print *,'after recv HSNO'
747     
748           end if
749           
750           if (Coupler_id.lt.0) return    !   <- standalone mode
751     
752           if (RECV .and. kdt > 1) then
753     
754             SST_ave=SST_ave+SST_cc
755             do j=1,latd
756               do i=1,lonr
757                 if (abs(SLMSK(i,j)-SLM_OS_value).lt.0.01) then 
758                 if (FICE_cc(i,j).GE.CIMIN) then
759                   SLMSK(i,j)=2.0
760                   FICE(i,j)=FICE_cc(i,j)
761                   HICE(i,j)=MAX(MIN(HICE_cc(i,j)/FICE_cc(i,j),HIMAX),HIMIN)
762                   SHELEG(i,j)=HSNO_cc(i,j)*DS
763                   TISFC(i,j)=(TSEA(i,j)-(1.-FICE_cc(i,j))*TFW)/FICE_cc(i,j)
764                 end if
765                 else if (SLMSK(i,j).GT.1.5) then
766                 if (FICE_cc(i,j).GE.CIMIN) then
767                   FICE(i,j)=FICE_cc(i,j)
768                   HICE(i,j)=MAX(MIN(HICE_cc(i,j)/FICE_cc(i,j),HIMAX),HIMIN)
769                   SHELEG(i,j)=HSNO_cc(i,j)*DS
770                   TSEA(i,j)=TISFC(i,j)*FICE_cc(i,j)+TFW*(1.-FICE_cc(i,j))
771                 else
772                   FICE(i,j)=0.0
773                   HICE(i,j)=0.0
774                   SHELEG(i,j)=0.0
775                   TSEA(i,j)=TFW
776                   TISFC(i,j)=TFW
777                   SLMSK(i,j)=0.0
778                 end if
779                 else
780                   FICE(i,j)=0.0
781                   HICE(i,j)=0.0
782                 end if
783               end do
784             end do
785     
786           endif
787     
788           if (lsout_cc_momocn) then
789             if(kdt > i_dto2dta_cc) then
790     !     print *,' sst_ave=',sst_ave(1,1),' dta2dto_cc=',dta2dto_cc
791               SST_ave=SST_ave*dta2dto_cc
792               do j=1,latd
793                 do i=1,lonr
794                   if (abs(SLMSK(i,j)-SLM_OS_value).lt.0.01) then
795                     if (SST_ave(i,j).gt.unrealistically_low_SST)
796          >          TSEA(i,j)=SST_ave(i,j)-OROGR(i,j)*RLAPSE
797                   end if
798                 end do
799               end do
800               SST_ave=0.
801             else
802               SST_ave=0.
803             endif
804           endif
805     
806           deallocate(FICE_cc)
807           deallocate(HICE_cc)
808           deallocate(HSNO_cc)
809     
810           contains
811     
812           SUBROUTINE ATM_TILES_RECV(f,fval,iord)
813     
814           implicit none
815           real (kind=kind_REAL) f(lonr,latd)
816           real,optional,intent(in) ::  fval
817           integer,optional,intent(in) :: iord
818     
819           real (kind=kind_REAL) f1(lonr,latd)
820           real (kind=kind_REAL) x(lonf,latg)
821           integer kmsk(lonr,latd),i,j,iiord,ik
822     !
823     
824           if (Coupler_id.lt.0) return    !   <- standalone mode
825     
826     
827           call CMP_RECV(x,N2D)
828     
829           call DISASSEMBLE_cc(x,f1)
830     
831           kmsk=ISLM_FG
832           ik=0
833           if ( present(fval) )then
834            do j=1,latd
835             do i=1,lonr
836               if (f1(i,j).le.fval) kmsk(i,j)=1
837               if (f1(i,j).le.fval) ik=ik+1
838             end do
839            end do
840     !      print *,'iiord=',iiord,'ik=',ik,'fval=',fval
841           endif
842           if ( present(iord) ) then
843               iiord=iord
844           else
845               iiord=2
846           endif
847     !      print *,'iiord=',iiord,'ik=',ik
848           call interpred_cc(iiord,kmsk,f1,f)
849                     ! <- interpolation TO reduced grid (i.e. with # of
850                     ! longitudes varying from lat. circle to lat. circle)
851                     ! from full grid
852     
853           END subroutine ATM_TILES_RECV
854     
855           END subroutine
856     !
857     !***********************************************************************
858     !
859           SUBROUTINE ATM_ANNOUNCE(s,DbgLev)
860     
861           USE ATM_cc, ONLY: nunit_announce_cc,VerbLev
862     
863           implicit none
864     
865           character*(*) s
866           integer DbgLev
867     !
868           if (DbgLev.le.VerbLev)
869          >  CALL CMP_ANNOUNCE(nunit_announce_cc,'AM: '//s)
870     
871           return
872           END
873     !
874     !***********************************************************************
875     !
876           SUBROUTINE ATM_DBG1(KDT,s,DbgLev)
877     
878           USE ATM_cc, ONLY: nunit_announce_cc,VerbLev
879           USE SURFACE_cc
880     
881           implicit none
882     
883           integer KDT
884           character*(*) s
885           integer DbgLev
886     !
887           if (DbgLev.gt.VerbLev) RETURN
888     
889     !--> cpl change: write lsout_cc_momice and lsout_cc_momocn  <--
890           write(s_cc,'("'//trim(s)//
891          >': KDT=",i8," lsout_cc_momice=",L1, 
892          >" lsout_cc_momocn=",L1," lgetSSTICE_cc=",L1)'
893          >) KDT,lsout_cc_momice,lsout_cc_momocn,lgetSSTICE_cc
894     
895           CALL CMP_ANNOUNCE(nunit_announce_cc,'AM: DBG1: '//s_cc)
896     
897           return
898           END
899     !
900     !***********************************************************************
901     !
902           SUBROUTINE ATM_DBG2(KDT,PHOUR,ZHOUR,SHOUR,DbgLev)
903     
904           USE ATM_cc, ONLY: nunit_announce_cc,VerbLev
905           USE SURFACE_cc
906     
907           implicit none
908     
909           integer KDT
910           real PHOUR,ZHOUR,SHOUR
911           integer DbgLev
912     !
913     !           print*,'AM: ATM_DBG2 entered'
914     
915           if (DbgLev.gt.VerbLev) RETURN
916     
917     !           print*,'AM: ATM_DBG2 to do write(s_cc, ...'
918     
919     !--> cpl change: write lsout_cc_momice and lsout_cc_momocn  <--
920     !
921           write(s_cc,'("do_tstep entry",i6," KDT=",i8,'//
922          >'" PHOUR,ZHOUR,SHOUR: ",1p,3e15.7,0p," lsout_cc_momice=",L1,'//
923          >'" lsout_cc_momocn=",L1,'//
924          >'" lgetSSTICE_cc=",L1)') n_do_tstep_cc,KDT,PHOUR,ZHOUR,SHOUR,
925          > lsout_cc_momice,lsout_cc_momocn,lgetSSTICE_cc
926     
927           CALL CMP_ANNOUNCE(nunit_announce_cc,'AM: DBG2: '//s_cc)
928     
929           return
930           END
931     !
932     !***********************************************************************
933     !
934           subroutine ATM_TSTEP_INIT(KDT)
935     
936           USE namelist_physics_def, ONLY: lssav
937           USE SURFACE_cc
938     
939           implicit none
940     
941           integer KDT
942     !
943     
944           call ATM_ANNOUNCE('DOTSTEP entered, in ATM_TSTEP_INIT',3)
945           n_do_tstep_cc=n_do_tstep_cc+1
946           lssav_cc=lssav
947           l_df_cc=.not.lssav   ! - double-check
948     !--> cpl deletion 
949     !d      lsout_cc=(MOD(KDT,i_dtc2dta_cc).eq.0)  ! <- still double-check
950     !d     > .and. .not. l_df_cc
951     !<-- cpl deletion 
952     !--> cpl insertion
953           lsout_cc_momice=(MOD(KDT,max(1,i_dtc2dta_cc)).eq.0)  ! <- still double-check
954          > .and. .not. l_df_cc                         ! <- instantaneous vars
955           lsout_cc_momocn=(MOD(KDT,max(1,i_dto2dta_cc)).eq.0)  ! <- still double-check
956          > .and. .not. l_df_cc
957     !<-- cpl insertion
958           lgetSSTICE_cc=MOD(KDT,max(1,i_dtc2dta_cc)).eq.0                !-check!
959          > .and. .not. l_df_cc
960     
961           if (kdt == 1) then
962             print *,'in ATM initial,kdt=',kdt,'dtc/dta=', i_dtc2dta_cc,
963          >    'dto/dta=',i_dto2dta_cc,'lsout_cc_momice=',
964          >    lsout_cc_momice, 
965          >   'lsout_cc_momocn=',lsout_cc_momocn,'lgetSSTICE_cc=',
966          &    lgetSSTICE_cc,'lssav=',lssav,MOD(KDT,max(1,i_dtc2dta_cc))
967          >                  ,MOD(KDT,max(1,i_dto2dta_cc))
968           endif
969           return
970           end
971     !
972     !***********************************************************************
973     !
974           subroutine ATM_SENDFLUXES(SLMSK)
975     
976           USE ATM_cc, ONLY: lonr,latd
977     
978           USE SURFACE_cc
979     
980           implicit none
981     
982           real (kind=kind_SLMSK) SLMSK(lonr,latd)
983           integer i,j
984     !
985     
986     !--> cpl insertion: send model vars first to coupler
987            if (lsout_cc_momice) then
988             call ATM_ANNOUNCE('to send T_SFC',2)
989             call ATM_SENDFLUX(T_SFC_cc)
990             call ATM_ANNOUNCE('to send T_BOT',2)
991     !       print *,'SEND FLUXES, T_BOt(1:10)=',T_BOT_cc(1:10,1)
992             call ATM_SENDFLUX(T_BOT_cc)
993             call ATM_ANNOUNCE('to send U_BOT',2)
994             call ATM_SENDFLUX(U_BOT_cc)
995             call ATM_ANNOUNCE('to send V_BOT',2)
996             call ATM_SENDFLUX(V_BOT_cc)
997             call ATM_ANNOUNCE('to send Q_BOT',2)
998             call ATM_SENDFLUX(Q_BOT_cc)
999             call ATM_ANNOUNCE('to send P_BOT',2)
1000             call ATM_SENDFLUX(P_BOT_cc)
1001             call ATM_ANNOUNCE('to send P_SURF',2)
1002             call ATM_SENDFLUX(P_SURF_cc)
1003             call ATM_ANNOUNCE('to send Z_BOT',2)
1004             call ATM_SENDFLUX(Z_BOT_cc)
1005             call ATM_ANNOUNCE('to send XMU',2)
1006             call ATM_SENDFLUX(XMU_cc)
1007             call ATM_ANNOUNCE('to send DLW',2)
1008             call ATM_SENDFLUX(DLW_cc)
1009             call ATM_ANNOUNCE('to send DSW',2)
1010             call ATM_SENDFLUX(DSW_cc)
1011             call ATM_ANNOUNCE('to send ffmm',2)
1012             call ATM_SENDFLUX(ffmm_cc)
1013             call ATM_ANNOUNCE('to send ffhh',2)
1014             call ATM_SENDFLUX(ffhh_cc)
1015             call ATM_ANNOUNCE('end of send variables',2)
1016     
1017             call atm_maxmin(lonr,latd,SNW_cc,'in ATM, snw_cc')
1018     
1019             SNW_cc(:,:)=SNW_cc(:,:)/dt_cc*1.E3
1020             call atm_maxmin(lonr,latd,SNW_cc,'in ATM,2 snw_cc')
1021     
1022             call ATM_SENDFLUX(SNW_cc)
1023             call ATM_ANNOUNCE('precip SNW sent',2)
1024     
1025             LPREC_cc(:,:)=LPREC_cc(:,:)/dt_cc*1.E3
1026             call atm_maxmin(lonr,latd,LPREC_cc,'in ATM,2 lprec_cc')
1027             call ATM_SENDFLUX(LPREC_cc)
1028             call ATM_ANNOUNCE('liquid precip sent',2)
1029     
1030     !       Sending original hice and fice
1031     !
1032             call ATM_SENDFLUX(FICE_SFC_cc)
1033             call ATM_ANNOUNCE('to send fice',2)
1034             call ATM_SENDFLUX(HICE_SFC_cc)
1035             call ATM_ANNOUNCE('to send hice',2)
1036     !
1037     
1038             T_BOT_cc=0.
1039             U_BOT_cc=0.
1040             V_BOT_cc=0.
1041             Q_BOT_cc=0.
1042             P_BOT_cc=0.
1043             P_SURF_cc=0.
1044             Z_BOT_cc=0.
1045             T_SFC_cc=0.
1046             XMU_cc=0.
1047             DSW_cc=0.
1048             DLW_cc=0.
1049             ffmm_cc=0.
1050             ffhh_cc=0.
1051             snw_cc=0.
1052             lprec_cc=0.
1053            endif
1054     !<-- cpl insertion
1055     
1056           if (lsout_cc_momocn) then
1057             DUSFC_cc=-DUSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
1058             DVSFC_cc=-DVSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
1059             DTSFC_cc=DTSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
1060             DQSFC_cc=DQSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
1061             DLWSFC_cc=DLWSFC_cc*dta2dto_cc !-------, *const*ps may be needed
1062             ULWSFC_cc=ULWSFC_cc*dta2dto_cc !-------, *const*ps may be needed
1063             SWSFC_cc=-SWSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
1064             PRECR_cc=PRECR_cc/dto_cc      ! assign dt_cc -- OM time step
1065                                     ! <- (above, it was "AM" instead of
1066                                     ! OM in the commentary - apparently
1067                                     ! by mistake or misprint, but it
1068                                     ! resulted in actual assignment of
1069                                     ! AM time step to dt_cc)
1070          >            *1.E3   ! <- don't know why. See treatment of
1071                              ! GESHEM in wrtsfc.f, wrtsfc_comm.f (7/16/04)
1072             call ATM_ANNOUNCE('to send fluxes',2)
1073             call ATM_SENDFLUX(DUSFC_cc,SLMSK=SLMSK)
1074             call ATM_ANNOUNCE('x-stress sent',2)
1075             call ATM_SENDFLUX(DVSFC_cc,SLMSK=SLMSK)
1076             call ATM_ANNOUNCE('y-stress sent',2)
1077     !        DTSFC_cc=DTSFC_cc+DQSFC_cc-DLWSFC_cc+ULWSFC_cc+SWSFC_cc
1078             DTSFC_cc=DTSFC_cc
1079             call ATM_SENDFLUX(DTSFC_cc,SLMSK=SLMSK)
1080             call ATM_ANNOUNCE('Q (net heat flux) sent',2)
1081     !        DQSFC_cc=DQSFC_cc/hvap_cc-PRECR_cc
1082             DQSFC_cc=DQSFC_cc/hvap_cc
1083             call ATM_SENDFLUX(DQSFC_cc,SLMSK=SLMSK)
1084             call ATM_ANNOUNCE('E-P sent',2)
1085     !
1086             DLWSFC_cc=DLWSFC_cc-ULWSFC_cc
1087             call ATM_SENDFLUX(DLWSFC_cc,SLMSK=SLMSK)
1088             call ATM_ANNOUNCE('net LWR sent',2)
1089             call ATM_SENDFLUX(SWSFC_cc,SLMSK=SLMSK)
1090             call ATM_ANNOUNCE('net SWR sent',2)
1091     !XW     call ATM_SENDFLUX(PRECR_cc,SLMSK=SLMSK)
1092     !XW     call ATM_ANNOUNCE('PRECIP sent',2)
1093     !
1094             call ATM_ANNOUNCE('fluxes sent',2)
1095             DUSFC_cc=0.
1096             DVSFC_cc=0.
1097             DTSFC_cc=0.
1098             DQSFC_cc=0.
1099             PRECR_cc=0.
1100             DLWSFC_cc=0.
1101             ULWSFC_cc=0.
1102             SWSFC_cc=0.
1103           end if
1104     
1105           contains
1106     !===
1107           SUBROUTINE ATM_SENDFLUX(f,SLMSK)
1108     
1109           USE ATM_cc
1110     
1111           USE SURFACE_cc, ONLY: ISLM_RG,
1112          >kind_sfcflux,kind_SLMSK,SLM_OS_value,
1113          >unrealistically_low_SV,unrealistically_low_SVp
1114     
1115           implicit none
1116     
1117           real (kind=kind_sfcflux),intent(in) :: f(lonr,latd)
1118     !--> cpl deletion
1119     !      real (kind=kind_SLMSK) SLMSK(lonr,latd)
1120     !<-- cpl deletion
1121           real (kind=kind_SLMSK),optional,intent(in)  :: SLMSK(lonr,latd)
1122     
1123           real(kind=kind_REAL), dimension(lonr,latd):: f1,f2
1124           real (kind=kind_REAL) x(lonf,latg)
1125           integer kmsk(lonr,latd)
1126           integer iord /2/
1127           integer i,j
1128           character*40 s
1129     !
1130     
1131           if (Coupler_id.lt.0) return    !   <- standalone mode
1132     
1133           f1(:,:)=f(:,:)
1134           kmsk=ISLM_RG
1135     
1136     !      ISLM_RG is local (per process) mask array that is
1137     !      CONSTANT in time. It contains 0 for either open sea (OS) or
1138     !      sea ice (SI) and 1 for land (L). KEEP IN MIND: it's on REDUCED G.
1139     
1140     !--> cpl insertion
1141           if ( present(SLMSK) ) then
1142     !<-- cpl insertion
1143           do j=1,latd
1144           do i=1,lonr
1145     !        if (abs(SLMSK(i,j)-SLM_OS_value).lt.0.01) then
1146     !                                  ! i.e. if it is OS (open sea) AMGP
1147             if (abs(SLMSK(i,j)-2.).lt.1.E-5              ! sea ice
1148          >      .or. abs(SLMSK(i,j)).lt.1.E-5) then      ! open sea  AM
1149               kmsk(i,j)=0
1150             else
1151               kmsk(i,j)=1
1152             end if
1153           end do
1154           end do
1155     
1156           endif
1157     
1158     !       SLMSK is (per-process-) local mask array regularly updated
1159     !       with sea ice data
1160     
1161           call uninterpred_cc(iord,kmsk,f1,f2)
1162                     ! <- interpolation FROM reduced grid (i.e. with # of
1163                     ! longitudes varying from lat. circle to lat. circle)
1164                     ! to full grid
1165     !
1166     !      print *,'in SEND_FLUX, before assemble_cc'
1167           call  ASSEMBLE_cc(x,f2)
1168     
1169     !      print *,'in SEND_FLUX, testing, x=',x(1:5,1),'f=',f(1:5,1),
1170     !     >   'f1=',f1(1:5,1),'f2=',f2(1:5,1)
1171           call CMP_SEND(x,N2D)
1172     
1173           END subroutine ATM_SENDFLUX
1174     
1175           end subroutine
1176     ! ******************************************************************
1177            subroutine atm_maxmin(xdim,ydim,x,s)
1178       
1179            USE ATM_cc
1180     
1181            implicit none
1182     
1183            integer xdim,ydim,i,j
1184            real(kind=kind_REAL) x(xdim,ydim),xmax,xmin
1185            character(*) s
1186     
1187           xmax=x(1,1)
1188           xmin=x(1,1)
1189           do j=1,ydim
1190           do i=1,xdim
1191            if ( xmax .lt. x(i,j) ) xmax=x(i,j)
1192            if ( xmin .gt. x(i,j) ) xmin=x(i,j)
1193           enddo
1194           enddo
1195     !     print *,s//' in atm_maxmin,xdim=',xdim,'ydim=',ydim,
1196     !    >   'xmax=',xmax,'xmin=',xmin
1197     
1198           return
1199           end
1200     ! ******************************************************************
1201            subroutine atm_maxmin_int(xdim,ydim,x,s)
1202     
1203            USE ATM_cc
1204     
1205            implicit none
1206     
1207            integer xdim,ydim,i,j
1208            integer x(xdim,ydim),xmax,xmin
1209            character(*) s
1210     
1211           xmax=x(1,1)
1212           xmin=x(1,1)
1213           do j=1,ydim
1214           do i=1,xdim
1215            if ( xmax .lt. x(i,j) ) xmax=x(i,j)
1216            if ( xmin .gt. x(i,j) ) xmin=x(i,j)
1217           enddo
1218           enddo
1219           print *,s//' in atm_maxmin,xdim=',xdim,'ydim=',ydim,
1220          >   'xmax=',xmax,'xmin=',xmin
1221     
1222           return
1223           end
1224     
1225