3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621 USE avg_mod, ONLY : avg
3622 USE avg_mod, ONLY : ifld_airrhm, &
3623 & ifld_airshm, &
3624 & ifld_airtmp, &
3625 & ifld_heaflx, &
3626 & ifld_lahflx, &
3627 & ifld_lonflx, &
3628 & ifld_lwdown, &
3629 & ifld_mstflx, &
3630 & ifld_sehflx, &
3631 & ifld_slpres, &
3632 & ifld_solflx, &
3633 & ifld_stress_u_true, &
3634 & ifld_stress_v_true, &
3635 & ifld_swdown, &
3636 & ifld_ttlprr, &
3637 & ifld_u10_true, &
3638 & ifld_v10_true
3639 USE coamm_memm, ONLY : adom
3640 USE domdec, ONLY : iminf, imaxf, jminf, jmaxf
3641
3642
3643
3644 integer, intent(in) :: ng
3645 integer, intent(out) :: rc
3646
3647 TYPE (ESMF_GridComp) :: model
3648
3649
3650
3651 integer :: ifld, i, is, j
3652 integer :: Istr, Iend, Jstr, Jend
3653 integer :: year, month, day, hour, minutes, seconds, sN, SD
3654 integer :: ExportCount
3655 integer :: localDE, localDEcount, localPET, PETcount
3656
3657 real (dp), parameter :: Emiss = 0.97_dp
3658 real (dp), parameter :: StBolt = 5.67051e-8_dp
3659 real (dp), parameter :: z1 = 3.0_dp
3660
3661 real (dp) :: Fseconds, TimeInDays, Time_Current
3662 real (dp) :: cff1, cff2, f1, scale
3663
3664 real (dp) :: MyFmax(1), MyFmin(1), Fmin(1), Fmax(1), Fval
3665
3666 real (dp), pointer :: ptr2d(:,:) => null()
3667
3668 character (len=22) :: Time_CurrentString
3669
3670 character (len=*), parameter :: MyFile = &
3671 & __FILE__//", COAMPS_Export"
3672
3673 character (ESMF_MAXSTR) :: cname, ofile
3674 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
3675
3676 TYPE (ESMF_Clock) :: clock
3677 TYPE (ESMF_Field) :: field
3678 TYPE (ESMF_State) :: ExportState
3679 TYPE (ESMF_Time) :: CurrentTime
3680 TYPE (ESMF_VM) :: vm
3681
3682
3683
3684
3685
3686 IF (esm_track) THEN
3687 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_Export', &
3688 & ', PET', petrank
3689 FLUSH (trac)
3690 END IF
3691 rc=esmf_success
3692
3693
3694
3695
3696
3697 CALL esmf_gridcompget (model, &
3698 & exportstate=exportstate, &
3699 & clock=clock, &
3700 & localpet=localpet, &
3701 & petcount=petcount, &
3702 & vm=vm, &
3703 & name=cname, &
3704 & rc=rc)
3705 IF (esmf_logfounderror(rctocheck=rc, &
3706 & msg=esmf_logerr_passthru, &
3707 & line=__line__, &
3708 & file=myfile)) THEN
3709 RETURN
3710 END IF
3711
3712
3713
3714
3715
3716 CALL esmf_gridget (models(iatmos)%grid(ng), &
3717 & localdecount=localdecount, &
3718 & rc=rc)
3719 IF (esmf_logfounderror(rctocheck=rc, &
3720 & msg=esmf_logerr_passthru, &
3721 & line=__line__, &
3722 & file=myfile)) THEN
3723 RETURN
3724 END IF
3725
3726
3727
3728
3729
3730 CALL esmf_clockget (clock, &
3731 & currtime=currenttime, &
3732 & rc=rc)
3733 IF (esmf_logfounderror(rctocheck=rc, &
3734 & msg=esmf_logerr_passthru, &
3735 & line=__line__, &
3736 & file=myfile)) THEN
3737 RETURN
3738 END IF
3739
3740 CALL esmf_timeget (currenttime, &
3741 & yy=year, &
3742 & mm=month, &
3743 & dd=day, &
3744 & h =hour, &
3745 & m =minutes, &
3746 & s =seconds, &
3747 & sn=sn, &
3748 & sd=sd, &
3749 & rc=rc)
3750 IF (esmf_logfounderror(rctocheck=rc, &
3751 & msg=esmf_logerr_passthru, &
3752 & line=__line__, &
3753 & file=myfile)) THEN
3754 RETURN
3755 END IF
3756
3757 CALL esmf_timeget (currenttime, &
3758 & s_r8=time_current, &
3759 & timestring=time_currentstring, &
3760 & rc=rc)
3761 IF (esmf_logfounderror(rctocheck=rc, &
3762 & msg=esmf_logerr_passthru, &
3763 & line=__line__, &
3764 & file=myfile)) THEN
3765 RETURN
3766 END IF
3767 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
3768 timeindays=time_current/86400.0_dp
3769 is=index(time_currentstring, 'T')
3770 IF (is.gt.0) time_currentstring(is:is)=' '
3771
3772
3773
3774
3775
3776 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
3777 & itemcount=exportcount, &
3778 & rc=rc)
3779 IF (esmf_logfounderror(rctocheck=rc, &
3780 & msg=esmf_logerr_passthru, &
3781 & line=__line__, &
3782 & file=myfile)) THEN
3783 RETURN
3784 END IF
3785
3786 IF (.not. allocated(exportnamelist)) THEN
3787 allocate ( exportnamelist(exportcount) )
3788 END IF
3789 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
3790 & itemnamelist=exportnamelist, &
3791 & rc=rc)
3792 IF (esmf_logfounderror(rctocheck=rc, &
3793 & msg=esmf_logerr_passthru, &
3794 & line=__line__, &
3795 & file=myfile)) THEN
3796 RETURN
3797 END IF
3798
3799
3800
3801
3802
3803 fld_loop : DO ifld=1,exportcount
3804
3805
3806
3807 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
3808 & trim(exportnamelist(ifld)), &
3809 & field, &
3810 & rc=rc)
3811 IF (esmf_logfounderror(rctocheck=rc, &
3812 & msg=esmf_logerr_passthru, &
3813 & line=__line__, &
3814 & file=myfile)) THEN
3815 RETURN
3816 END IF
3817
3818
3819
3820
3821 de_loop : DO localde=0,localdecount-1
3822 CALL esmf_fieldget (field, &
3823 & localde=localde, &
3824 & farrayptr=ptr2d, &
3825 & rc=rc)
3826 IF (esmf_logfounderror(rctocheck=rc, &
3827 & msg=esmf_logerr_passthru, &
3828 & line=__line__, &
3829 & file=myfile)) THEN
3830 RETURN
3831 END IF
3832 istr=lbound(ptr2d,1)
3833 iend=ubound(ptr2d,1)
3834 jstr=lbound(ptr2d,2)
3835 jend=ubound(ptr2d,2)
3836
3837
3838
3839 ptr2d=missing_dp
3840
3841
3842
3843
3844
3845
3846 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
3847
3848
3849
3850 CASE ('psfc', 'Pair')
3851 myfmin(1)= missing_dp
3852 myfmax(1)=-missing_dp
3853 DO j=jstr,jend
3854 DO i=istr,iend
3855 fval=avg(ng)%fld(ifld_slpres)%p(i,j)
3856 myfmin(1)=min(myfmin(1),fval)
3857 myfmax(1)=max(myfmax(1),fval)
3858 ptr2d(i,j)=fval
3859 END DO
3860 END DO
3861
3862
3863
3864 CASE ('tsfc', 'Tair')
3865 myfmin(1)= missing_dp
3866 myfmax(1)=-missing_dp
3867 DO j=jstr,jend
3868 DO i=istr,iend
3869 fval=avg(ng)%fld(ifld_airtmp)%p(i,j)
3870 myfmin(1)=min(myfmin(1),fval)
3871 myfmax(1)=max(myfmax(1),fval)
3872 ptr2d(i,j)=fval
3873 END DO
3874 END DO
3875
3876
3877
3878 CASE ('Hair')
3879 myfmin(1)= missing_dp
3880 myfmax(1)=-missing_dp
3881 DO j=jstr,jend
3882 DO i=istr,iend
3883 fval=avg(ng)%fld(ifld_airshm)%p(i,j)
3884 myfmin(1)=min(myfmin(1),fval)
3885 myfmax(1)=max(myfmax(1),fval)
3886 ptr2d(i,j)=fval
3887 END DO
3888 END DO
3889
3890
3891
3892 CASE ('qsfc', 'Qair')
3893 myfmin(1)= missing_dp
3894 myfmax(1)=-missing_dp
3895 DO j=jstr,jend
3896 DO i=istr,iend
3897 fval=avg(ng)%fld(ifld_airrhm)%p(i,j)
3898 myfmin(1)=min(myfmin(1),fval)
3899 myfmax(1)=max(myfmax(1),fval)
3900 ptr2d(i,j)=fval
3901 END DO
3902 END DO
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918 CASE ('nflx', 'shflux')
3919 myfmin(1)= missing_dp
3920 myfmax(1)=-missing_dp
3921 f1=1.0_dp-0.27_dp*exp(-2.80_dp*z1)- &
3922 & 0.45_dp*exp(-0.07_dp*z1)
3923 DO j=jstr,jend
3924 DO i=istr,iend
3925 cff1=adom(ng)%tsea(i,j)*adom(ng)%tsea(i,j)* &
3926 & adom(ng)%tsea(i,j)*adom(ng)%tsea(i,j)
3927 cff2=emiss*stbolt*cff1
3928 fval=avg(ng)%fld(ifld_solflx)%p(i,j)*f1+ &
3929 & avg(ng)%fld(ifld_lwdown)%p(i,j)-cff2- &
3930 & avg(ng)%fld(ifld_lahflx)%p(i,j)- &
3931 & avg(ng)%fld(ifld_sehflx)%p(i,j)
3932 myfmin(1)=min(myfmin(1),fval)
3933 myfmax(1)=max(myfmax(1),fval)
3934 ptr2d(i,j)=fval
3935 END DO
3936 END DO
3937
3938
3939
3940 CASE ('lwrd', 'LWrad')
3941 myfmin(1)= missing_dp
3942 myfmax(1)=-missing_dp
3943 DO j=jstr,jend
3944 DO i=istr,iend
3945 fval=avg(ng)%fld(ifld_lonflx)%p(i,j)
3946 myfmin(1)=min(myfmin(1),fval)
3947 myfmax(1)=max(myfmax(1),fval)
3948 ptr2d(i,j)=fval
3949 END DO
3950 END DO
3951
3952
3953
3954 CASE ('dlwrd', 'dLWrad', 'lwrad_down')
3955 myfmin(1)= missing_dp
3956 myfmax(1)=-missing_dp
3957 DO j=jstr,jend
3958 DO i=istr,iend
3959 fval=avg(ng)%fld(ifld_lwdown)%p(i,j)
3960 myfmin(1)=min(myfmin(1),fval)
3961 myfmax(1)=max(myfmax(1),fval)
3962 ptr2d(i,j)=fval
3963 END DO
3964 END DO
3965
3966
3967
3968 CASE ('swrd', 'SWrad')
3969 myfmin(1)= missing_dp
3970 myfmax(1)=-missing_dp
3971 DO j=jstr,jend
3972 DO i=istr,iend
3973 fval=avg(ng)%fld(ifld_solflx)%p(i,j)
3974 myfmin(1)=min(myfmin(1),fval)
3975 myfmax(1)=max(myfmax(1),fval)
3976 ptr2d(i,j)=fval
3977 END DO
3978 END DO
3979
3980
3981
3982 CASE ('dswrd', 'dSWrad')
3983 myfmin(1)= missing_dp
3984 myfmax(1)=-missing_dp
3985 DO j=jstr,jend
3986 DO i=istr,iend
3987 fval=avg(ng)%fld(ifld_swdown)%p(i,j)
3988 myfmin(1)=min(myfmin(1),fval)
3989 myfmax(1)=max(myfmax(1),fval)
3990 ptr2d(i,j)=fval
3991 END DO
3992 END DO
3993
3994
3995
3996
3997
3998
3999 CASE ('lhfx', 'LHfx')
4000 myfmin(1)= missing_dp
4001 myfmax(1)=-missing_dp
4002 DO j=jstr,jend
4003 DO i=istr,iend
4004 fval=-avg(ng)%fld(ifld_lahflx)%p(i,j)
4005 myfmin(1)=min(myfmin(1),fval)
4006 myfmax(1)=max(myfmax(1),fval)
4007 ptr2d(i,j)=fval
4008 END DO
4009 END DO
4010
4011
4012
4013
4014
4015 CASE ('shfx', 'SHfx')
4016 myfmin(1)= missing_dp
4017 myfmax(1)=-missing_dp
4018 DO j=jstr,jend
4019 DO i=istr,iend
4020 fval=-avg(ng)%fld(ifld_sehflx)%p(i,j)
4021 myfmin(1)=min(myfmin(1),fval)
4022 myfmax(1)=max(myfmax(1),fval)
4023 ptr2d(i,j)=fval
4024 END DO
4025 END DO
4026
4027
4028
4029
4030
4031 CASE ('swflux')
4032 myfmin(1)= missing_dp
4033 myfmax(1)=-missing_dp
4034 DO j=jstr,jend
4035 DO i=istr,iend
4036 fval=-avg(ng)%fld(ifld_mstflx)%p(i,j)
4037 myfmin(1)=min(myfmin(1),fval)
4038 myfmax(1)=max(myfmax(1),fval)
4039 ptr2d(i,j)=fval
4040 END DO
4041 END DO
4042
4043
4044
4045
4046 CASE ('rain')
4047 myfmin(1)= missing_dp
4048 myfmax(1)=-missing_dp
4049 scale=10.0_dp
4050 DO j=jstr,jend
4051 DO i=istr,iend
4052 fval=avg(ng)%fld(ifld_ttlprr)%p(i,j)*scale
4053 myfmin(1)=min(myfmin(1),fval)
4054 myfmax(1)=max(myfmax(1),fval)
4055 ptr2d(i,j)=fval
4056 END DO
4057 END DO
4058
4059
4060
4061 CASE ('taux', 'taux10', 'sustr')
4062 myfmin(1)= missing_dp
4063 myfmax(1)=-missing_dp
4064 DO j=jstr,jend
4065 DO i=istr,iend
4066 fval=avg(ng)%fld(ifld_stress_u_true)%p(i,j)
4067 myfmin(1)=min(myfmin(1),fval)
4068 myfmax(1)=max(myfmax(1),fval)
4069 ptr2d(i,j)=fval
4070 END DO
4071 END DO
4072
4073
4074
4075 CASE ('tauy', 'tauy10', 'svstr')
4076 myfmin(1)= missing_dp
4077 myfmax(1)=-missing_dp
4078 DO j=jstr,jend
4079 DO i=istr,iend
4080 fval=avg(ng)%fld(ifld_stress_v_true)%p(i,j)
4081 myfmin(1)=min(myfmin(1),fval)
4082 myfmax(1)=max(myfmax(1),fval)
4083 ptr2d(i,j)=fval
4084 END DO
4085 END DO
4086
4087
4088
4089 CASE ('Uwind', 'u10', 'wndu')
4090 myfmin(1)= missing_dp
4091 myfmax(1)=-missing_dp
4092 DO j=jstr,jend
4093 DO i=istr,iend
4094 fval=avg(ng)%fld(ifld_u10_true)%p(i,j)
4095 myfmin(1)=min(myfmin(1),fval)
4096 myfmax(1)=max(myfmax(1),fval)
4097 ptr2d(i,j)=fval
4098 END DO
4099 END DO
4100
4101
4102
4103 CASE ('Vwind', 'v10', 'wndv')
4104 myfmin(1)= missing_dp
4105 myfmax(1)=-missing_dp
4106 DO j=jstr,jend
4107 DO i=istr,iend
4108 fval=avg(ng)%fld(ifld_v10_true)%p(i,j)
4109 myfmin(1)=min(myfmin(1),fval)
4110 myfmax(1)=max(myfmax(1),fval)
4111 ptr2d(i,j)=fval
4112 END DO
4113 END DO
4114
4115
4116
4117 CASE DEFAULT
4118 IF (localpet.eq.0) THEN
4119 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
4120 & trim(cinpname)
4121 END IF
4122 rc=esmf_rc_not_found
4123 IF (esmf_logfounderror(rctocheck=rc, &
4124 & msg=esmf_logerr_passthru, &
4125 & line=__line__, &
4126 & file=myfile)) THEN
4127 RETURN
4128 END IF
4129 END SELECT
4130
4131
4132
4133
4134 IF (associated(ptr2d)) nullify (ptr2d)
4135 END DO de_loop
4136
4137
4138
4139 CALL esmf_vmallreduce (vm, &
4140 & senddata=myfmin, &
4141 & recvdata=fmin, &
4142 & count=1, &
4143 & reduceflag=esmf_reduce_min, &
4144 & rc=rc)
4145 IF (esmf_logfounderror(rctocheck=rc, &
4146 & msg=esmf_logerr_passthru, &
4147 & line=__line__, &
4148 & file=myfile)) THEN
4149 RETURN
4150 END IF
4151
4152 CALL esmf_vmallreduce (vm, &
4153 & senddata=myfmax, &
4154 & recvdata=fmax, &
4155 & count=1, &
4156 & reduceflag=esmf_reduce_max, &
4157 & rc=rc)
4158 IF (esmf_logfounderror(rctocheck=rc, &
4159 & msg=esmf_logerr_passthru, &
4160 & line=__line__, &
4161 & file=myfile)) THEN
4162 RETURN
4163 END IF
4164
4165
4166
4167 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
4168 WRITE (cplout,20) trim(exportnamelist(ifld)), &
4169 & trim(time_currentstring), ng, &
4170 & fmin(1), fmax(1)
4171 END IF
4172
4173
4174
4175 IF ((debuglevel.ge.3).and. &
4176 & models(iatmos)%ExportField(ifld)%debug_write) THEN
4177 WRITE (ofile,30) ng, trim(exportnamelist(ifld)), &
4178 & year, month, day, hour, minutes, seconds
4179 CALL esmf_fieldwrite (field, &
4180 & trim(ofile), &
4181 & overwrite=.true., &
4182 & rc=rc)
4183 IF (esmf_logfounderror(rctocheck=rc, &
4184 & msg=esmf_logerr_passthru, &
4185 & line=__line__, &
4186 & file=myfile)) THEN
4187 RETURN
4188 END IF
4189 END IF
4190 END DO fld_loop
4191
4192
4193
4194 IF (allocated(exportnamelist)) deallocate(exportnamelist)
4195
4196
4197
4198 IF (exportcount.gt.0) THEN
4199 models(iatmos)%ExportCalls=models(iatmos)%ExportCalls+1
4200 END IF
4201
4202 IF (esm_track) THEN
4203 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_Export', &
4204 & ', PET', petrank
4205 FLUSH (trac)
4206 END IF
4207 IF (debuglevel.gt.0) FLUSH (cplout)
4208
4209 10 FORMAT (/,2x,'COAMPS_Export - unable to find option to export: ', &
4210 & a,/,18x,'check ''Export(atmos)'' in input script: ',a)
4211 20 FORMAT (2x,'COAMPS_Export - ESMF: exporting field ''',a,'''', &
4212 & t72,a,2x,'Grid ',i2.2,/, &
4213 & 19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
4214 & ')')
4215 30 FORMAT ('coamps_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
4216 & i2.2,2('.',i2.2),'.nc')
4217
4218 RETURN