2770
2771
2772
2773
2774
2775
2776
2777 USE mod_update, ONLY : exportfields
2778 USE mod_dynparam, ONLY : ici1, ici2, jci1, jci2
2779
2780
2781
2782 integer, intent(in) :: ng
2783 integer, intent(out) :: rc
2784
2785 TYPE (ESMF_GridComp) :: model
2786
2787
2788
2789 integer :: ifld, i, is, j
2790 integer :: Istr, Iend, Jstr, Jend
2791 integer :: year, month, day, hour, minutes, seconds, sN, SD
2792 integer :: ExportCount
2793 integer :: localDE, localDEcount, localPET, PETcount
2794
2795 real (dp), parameter :: pi = 3.14159265358979323846_dp
2796 real (dp) :: Fseconds, TimeInDays, Time_Current
2797
2798 real (dp) :: MyFmax(1), MyFmin(1), Fmin(1), Fmax(1), Fval
2799
2800 real (dp), pointer :: ptr2d(:,:) => null()
2801
2802 character (len=22) :: Time_CurrentString
2803
2804 character (len=*), parameter :: MyFile = &
2805 & __FILE__//", RegCM_Export"
2806
2807 character (ESMF_MAXSTR) :: cname, ofile
2808 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
2809
2810 TYPE (ESMF_Clock) :: clock
2811 TYPE (ESMF_Field) :: field
2812 TYPE (ESMF_Time) :: CurrentTime
2813 TYPE (ESMF_VM) :: vm
2814
2815
2816
2817
2818
2819 IF (esm_track) THEN
2820 WRITE (trac,'(a,a,i0)') '==> Entering RegCM_Export', &
2821 & ', PET', petrank
2822 FLUSH (trac)
2823 END IF
2824 rc=esmf_success
2825
2826
2827
2828
2829
2830 CALL esmf_gridcompget (model, &
2831 & clock=clock, &
2832 & localpet=localpet, &
2833 & petcount=petcount, &
2834 & vm=vm, &
2835 & name=cname, &
2836 & rc=rc)
2837 IF (esmf_logfounderror(rctocheck=rc, &
2838 & msg=esmf_logerr_passthru, &
2839 & line=__line__, &
2840 & file=myfile)) THEN
2841 RETURN
2842 END IF
2843
2844
2845
2846
2847
2848 CALL esmf_gridget (models(iatmos)%grid(ng), &
2849 & localdecount=localdecount, &
2850 & rc=rc)
2851 IF (esmf_logfounderror(rctocheck=rc, &
2852 & msg=esmf_logerr_passthru, &
2853 & line=__line__, &
2854 & file=myfile)) THEN
2855 RETURN
2856 END IF
2857
2858
2859
2860
2861
2862 CALL esmf_clockget (clock, &
2863 & currtime=currenttime, &
2864 & rc=rc)
2865 IF (esmf_logfounderror(rctocheck=rc, &
2866 & msg=esmf_logerr_passthru, &
2867 & line=__line__, &
2868 & file=myfile)) THEN
2869 RETURN
2870 END IF
2871
2872 CALL esmf_timeget (currenttime, &
2873 & yy=year, &
2874 & mm=month, &
2875 & dd=day, &
2876 & h =hour, &
2877 & m =minutes, &
2878 & s =seconds, &
2879 & sn=sn, &
2880 & sd=sd, &
2881 & rc=rc)
2882 IF (esmf_logfounderror(rctocheck=rc, &
2883 & msg=esmf_logerr_passthru, &
2884 & line=__line__, &
2885 & file=myfile)) THEN
2886 RETURN
2887 END IF
2888
2889 CALL esmf_timeget (currenttime, &
2890 & s_r8=time_current, &
2891 & timestring=time_currentstring, &
2892 & rc=rc)
2893 IF (esmf_logfounderror(rctocheck=rc, &
2894 & msg=esmf_logerr_passthru, &
2895 & line=__line__, &
2896 & file=myfile)) THEN
2897 RETURN
2898 END IF
2899 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
2900 timeindays=time_current/86400.0_dp
2901 is=index(time_currentstring, 'T')
2902 IF (is.gt.0) time_currentstring(is:is)=' '
2903
2904
2905
2906
2907
2908 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
2909 & itemcount=exportcount, &
2910 & rc=rc)
2911 IF (esmf_logfounderror(rctocheck=rc, &
2912 & msg=esmf_logerr_passthru, &
2913 & line=__line__, &
2914 & file=myfile)) THEN
2915 RETURN
2916 END IF
2917
2918 IF (.not. allocated(exportnamelist)) THEN
2919 allocate ( exportnamelist(exportcount) )
2920 END IF
2921 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
2922 & itemnamelist=exportnamelist, &
2923 & rc=rc)
2924 IF (esmf_logfounderror(rctocheck=rc, &
2925 & msg=esmf_logerr_passthru, &
2926 & line=__line__, &
2927 & file=myfile)) THEN
2928 RETURN
2929 END IF
2930
2931
2932
2933
2934
2935
2936 CALL regcm_uvrot (exportfields%wndu, exportfields%wndv)
2937 CALL regcm_uvrot (exportfields%taux, exportfields%tauy)
2938
2939
2940
2941
2942
2943 fld_loop : DO ifld=1,exportcount
2944
2945
2946
2947 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
2948 & trim(exportnamelist(ifld)), &
2949 & field, &
2950 & rc=rc)
2951 IF (esmf_logfounderror(rctocheck=rc, &
2952 & msg=esmf_logerr_passthru, &
2953 & line=__line__, &
2954 & file=myfile)) THEN
2955 RETURN
2956 END IF
2957
2958
2959
2960
2961 de_loop : DO localde=0,localdecount-1
2962 CALL esmf_fieldget (field, &
2963 & localde=localde, &
2964 & farrayptr=ptr2d, &
2965 & rc=rc)
2966 IF (esmf_logfounderror(rctocheck=rc, &
2967 & msg=esmf_logerr_passthru, &
2968 & line=__line__, &
2969 & file=myfile)) THEN
2970 RETURN
2971 END IF
2972 istr=ici1
2973 iend=ici2
2974 jstr=jci1
2975 jend=jci2
2976
2977
2978
2979 ptr2d=missing_dp
2980
2981
2982
2983
2984
2985
2986 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
2987
2988
2989
2990 CASE ('psfc', 'Pair')
2991 fval=exportfields%psfc(jstr,istr)
2992 myfmin(1)=fval
2993 myfmax(1)=fval
2994 DO i=istr,iend
2995 DO j=jstr,jend
2996 fval=exportfields%psfc(j,i)
2997 myfmin(1)=min(myfmin(1),fval)
2998 myfmax(1)=max(myfmax(1),fval)
2999 ptr2d(i,j)=fval
3000 END DO
3001 END DO
3002
3003
3004
3005 CASE ('tsfc', 'Tair')
3006 fval=exportfields%tsfc(jstr,istr)
3007 myfmin(1)=fval
3008 myfmax(1)=fval
3009 DO i=istr,iend
3010 DO j=jstr,jend
3011 fval=exportfields%tsfc(j,i)
3012 myfmin(1)=min(myfmin(1),fval)
3013 myfmax(1)=max(myfmax(1),fval)
3014 ptr2d(i,j)=fval
3015 END DO
3016 END DO
3017
3018
3019
3020 CASE ('qsfc', 'Hair')
3021 fval=exportfields%qsfc(jstr,istr)
3022 myfmin(1)=fval
3023 myfmax(1)=fval
3024 DO i=istr,iend
3025 DO j=jstr,jend
3026 fval=exportfields%qsfc(j,i)
3027 myfmin(1)=min(myfmin(1),fval)
3028 myfmax(1)=max(myfmax(1),fval)
3029 ptr2d(i,j)=fval
3030 END DO
3031 END DO
3032
3033
3034
3035 CASE ('lwrd', 'LWrad')
3036 fval=exportfields%lwrd(jstr,istr)
3037 myfmin(1)=fval
3038 myfmax(1)=fval
3039 DO i=istr,iend
3040 DO j=jstr,jend
3041 fval=exportfields%lwrd(j,i)
3042 myfmin(1)=min(myfmin(1),fval)
3043 myfmax(1)=max(myfmax(1),fval)
3044 ptr2d(i,j)=fval
3045 END DO
3046 END DO
3047
3048
3049
3050 CASE ('dlwrd', 'dLWrad', 'lwrad_down')
3051 fval=exportfields%dlwr(jstr,istr)
3052 myfmin(1)=fval
3053 myfmax(1)=fval
3054 DO i=istr,iend
3055 DO j=jstr,jend
3056 fval=exportfields%dlwr(j,i)
3057 myfmin(1)=min(myfmin(1),fval)
3058 myfmax(1)=max(myfmax(1),fval)
3059 ptr2d(i,j)=fval
3060 END DO
3061 END DO
3062
3063
3064
3065 CASE ('lhfx', 'LHfx')
3066 fval=exportfields%lhfx(jstr,istr)
3067 myfmin(1)=fval
3068 myfmax(1)=fval
3069 DO i=istr,iend
3070 DO j=jstr,jend
3071 fval=exportfields%lhfx(j,i)
3072 myfmin(1)=min(myfmin(1),fval)
3073 myfmax(1)=max(myfmax(1),fval)
3074 ptr2d(i,j)=fval
3075 END DO
3076 END DO
3077
3078
3079
3080 CASE ('shfx')
3081 fval=exportfields%shfx(jstr,istr)
3082 myfmin(1)=fval
3083 myfmax(1)=fval
3084 DO i=istr,iend
3085 DO j=jstr,jend
3086 fval=exportfields%shfx(j,i)
3087 myfmin(1)=min(myfmin(1),fval)
3088 myfmax(1)=max(myfmax(1),fval)
3089 ptr2d(i,j)=fval
3090 END DO
3091 END DO
3092
3093
3094
3095 CASE ('prec')
3096 fval=exportfields%prec(jstr,istr)
3097 myfmin(1)=fval
3098 myfmax(1)=fval
3099 DO i=istr,iend
3100 DO j=jstr,jend
3101 fval=exportfields%prec(j,i)
3102 myfmin(1)=min(myfmin(1),fval)
3103 myfmax(1)=max(myfmax(1),fval)
3104 ptr2d(i,j)=fval
3105 END DO
3106 END DO
3107
3108
3109
3110 CASE ('Uwind', 'u10', 'wndu')
3111 fval=exportfields%wndu(jstr,istr)
3112 myfmin(1)=fval
3113 myfmax(1)=fval
3114 DO i=istr,iend
3115 DO j=jstr,jend
3116 fval=exportfields%wndu(j,i)
3117 myfmin(1)=min(myfmin(1),fval)
3118 myfmax(1)=max(myfmax(1),fval)
3119 ptr2d(i,j)=fval
3120 END DO
3121 END DO
3122
3123
3124
3125 CASE ('wndv')
3126 fval=exportfields%wndv(jstr,istr)
3127 myfmin(1)=fval
3128 myfmax(1)=fval
3129 DO i=istr,iend
3130 DO j=jstr,jend
3131 fval=exportfields%wndv(j,i)
3132 myfmin(1)=min(myfmin(1),fval)
3133 myfmax(1)=max(myfmax(1),fval)
3134 ptr2d(i,j)=fval
3135 END DO
3136 END DO
3137
3138
3139
3140 CASE ('swrd')
3141 fval=exportfields%swrd(jstr,istr)
3142 myfmin(1)=fval
3143 myfmax(1)=fval
3144 DO i=istr,iend
3145 DO j=jstr,jend
3146 fval=exportfields%swrd(j,i)
3147 myfmin(1)=min(myfmin(1),fval)
3148 myfmax(1)=max(myfmax(1),fval)
3149 ptr2d(i,j)=fval
3150 END DO
3151 END DO
3152
3153
3154
3155 CASE ('dswr')
3156 fval=exportfields%dswr(jstr,istr)
3157 myfmin(1)=fval
3158 myfmax(1)=fval
3159 DO i=istr,iend
3160 DO j=jstr,jend
3161 fval=exportfields%dswr(j,i)
3162 myfmin(1)=min(myfmin(1),fval)
3163 myfmax(1)=max(myfmax(1),fval)
3164 ptr2d(i,j)=fval
3165 END DO
3166 END DO
3167
3168
3169
3170 CASE ('rnof')
3171 fval=exportfields%rnof(jstr,istr)
3172 myfmin(1)=fval
3173 myfmax(1)=fval
3174 DO i=istr,iend
3175 DO j=jstr,jend
3176 fval=exportfields%rnof(j,i)
3177 myfmin(1)=min(myfmin(1),fval)
3178 myfmax(1)=max(myfmax(1),fval)
3179 ptr2d(i,j)=fval
3180 END DO
3181 END DO
3182
3183
3184
3185 CASE ('snof')
3186 fval=exportfields%snof(jstr,istr)
3187 myfmin(1)=fval
3188 myfmax(1)=fval
3189 DO i=istr,iend
3190 DO j=jstr,jend
3191 fval=exportfields%snof(j,i)
3192 myfmin(1)=min(myfmin(1),fval)
3193 myfmax(1)=max(myfmax(1),fval)
3194 ptr2d(i,j)=fval
3195 END DO
3196 END DO
3197
3198
3199
3200 CASE ('taux')
3201 fval=exportfields%taux(jstr,istr)
3202 myfmin(1)=fval
3203 myfmax(1)=fval
3204 DO i=istr,iend
3205 DO j=jstr,jend
3206 fval=exportfields%taux(j,i)
3207 myfmin(1)=min(myfmin(1),fval)
3208 myfmax(1)=max(myfmax(1),fval)
3209 ptr2d(i,j)=fval
3210 END DO
3211 END DO
3212
3213
3214
3215 CASE ('tauy')
3216 fval=exportfields%tauy(jstr,istr)
3217 myfmin(1)=fval
3218 myfmax(1)=fval
3219 DO i=istr,iend
3220 DO j=jstr,jend
3221 fval=exportfields%tauy(j,i)
3222 myfmin(1)=min(myfmin(1),fval)
3223 myfmax(1)=max(myfmax(1),fval)
3224 ptr2d(i,j)=fval
3225 END DO
3226 END DO
3227
3228
3229
3230 CASE ('wspd')
3231 fval=exportfields%wspd(jstr,istr)
3232 myfmin(1)=fval
3233 myfmax(1)=fval
3234 DO i=istr,iend
3235 DO j=jstr,jend
3236 fval=exportfields%wspd(j,i)
3237 myfmin(1)=min(myfmin(1),fval)
3238 myfmax(1)=max(myfmax(1),fval)
3239 ptr2d(i,j)=fval
3240 END DO
3241 END DO
3242
3243
3244
3245 CASE ('wdir')
3246 fval=atan2(exportfields%wndu(jstr,istr), &
3247 & exportfields%wndv(jstr,istr))
3248 myfmin(1)=fval
3249 myfmax(1)=fval
3250 DO i=istr,iend
3251 DO j=jstr,jend
3252 fval=atan2(exportfields%wndu(j,i), &
3253 & exportfields%wndv(j,i))
3254 IF (dd.lt.0.0_r8) fval=fval+2.0_r8*pi
3255 myfmin(1)=min(myfmin(1),fval)
3256 myfmax(1)=max(myfmax(1),fval)
3257 ptr2d(i,j)=fval
3258 END DO
3259 END DO
3260
3261
3262
3263 CASE ('nflx')
3264 fval=exportfields%nflx(jstr,istr)
3265 myfmin(1)=fval
3266 myfmax(1)=fval
3267 DO i=istr,iend
3268 DO j=jstr,jend
3269 fval=exportfields%nflx(j,i)
3270 myfmin(1)=min(myfmin(1),fval)
3271 myfmax(1)=max(myfmax(1),fval)
3272 ptr2d(i,j)=fval
3273 END DO
3274 END DO
3275
3276
3277
3278 CASE ('sflx')
3279 fval=exportfields%sflx(jstr,istr)
3280 myfmin(1)=fval
3281 myfmax(1)=fval
3282 DO i=istr,iend
3283 DO j=jstr,jend
3284 fval=exportfields%sflx(j,i)
3285 myfmin(1)=min(myfmin(1),fval)
3286 myfmax(1)=max(myfmax(1),fval)
3287 ptr2d(i,j)=fval
3288 END DO
3289 END DO
3290
3291
3292
3293 CASE ('snow')
3294 fval=exportfields%snow(jstr,istr)
3295 myfmin(1)=fval
3296 myfmax(1)=fval
3297 DO i=istr,iend
3298 DO j=jstr,jend
3299 fval=exportfields%snow(j,i)
3300 myfmin(1)=min(myfmin(1),fval)
3301 myfmax(1)=max(myfmax(1),fval)
3302 ptr2d(i,j)=fval
3303 END DO
3304 END DO
3305
3306
3307
3308 CASE DEFAULT
3309 IF (localpet.eq.0) THEN
3310 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
3311 & trim(cinpname)
3312 END IF
3313 rc=esmf_rc_not_found
3314 IF (esmf_logfounderror(rctocheck=rc, &
3315 & msg=esmf_logerr_passthru, &
3316 & line=__line__, &
3317 & file=myfile)) THEN
3318 RETURN
3319 END IF
3320 END SELECT
3321
3322
3323
3324
3325 IF (associated(ptr2d)) nullify (ptr2d)
3326 END DO de_loop
3327
3328
3329
3330 CALL esmf_vmallreduce (vm, &
3331 & senddata=myfmin, &
3332 & recvdata=fmin, &
3333 & count=1, &
3334 & reduceflag=esmf_reduce_min, &
3335 & rc=rc)
3336 IF (esmf_logfounderror(rctocheck=rc, &
3337 & msg=esmf_logerr_passthru, &
3338 & line=__line__, &
3339 & file=myfile)) THEN
3340 RETURN
3341 END IF
3342
3343 CALL esmf_vmallreduce (vm, &
3344 & senddata=myfmax, &
3345 & recvdata=fmax, &
3346 & count=1, &
3347 & reduceflag=esmf_reduce_max, &
3348 & rc=rc)
3349 IF (esmf_logfounderror(rctocheck=rc, &
3350 & msg=esmf_logerr_passthru, &
3351 & line=__line__, &
3352 & file=myfile)) THEN
3353 RETURN
3354 END IF
3355
3356
3357
3358 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
3359 WRITE (cplout,20) trim(exportnamelist(ifld)), &
3360 & trim(time_currentstring), ng, &
3361 & fmin(1), fmax(1)
3362 END IF
3363
3364
3365
3366 IF ((debuglevel.ge.3).and. &
3367 & models(iatmos)%ExportField(ifld)%debug_write) THEN
3368 WRITE (ofile,30) ng, trim(exportnamelist(ifld)), &
3369 & year, month, day, hour, minutes, seconds
3370 CALL esmf_fieldwrite (field, &
3371 & trim(ofile), &
3372 & overwrite=.true., &
3373 & rc=rc)
3374 IF (esmf_logfounderror(rctocheck=rc, &
3375 & msg=esmf_logerr_passthru, &
3376 & line=__line__, &
3377 & file=myfile)) THEN
3378 RETURN
3379 END IF
3380 END IF
3381 END DO fld_loop
3382
3383
3384
3385 IF (allocated(exportnamelist)) deallocate(exportnamelist)
3386
3387
3388
3389 IF (exportcount.gt.0) THEN
3390 models(iatmos)%ExportCalls=models(iatmos)%ExportCalls+1
3391 END IF
3392
3393 IF (esm_track) THEN
3394 WRITE (trac,'(a,a,i0)') '<== Exiting RegCM_Export', &
3395 & ', PET', petrank
3396 FLUSH (trac)
3397 END IF
3398 IF (debuglevel.gt.0) FLUSH (cplout)
3399
3400 10 FORMAT (/,2x,'RegCM_Export - unable to find option to export: ', &
3401 & a,/,18x,'check ''Export(atmos)'' in input script: ',a)
3402 20 FORMAT (2x,'RegCM_Export - ESMF: exporting field ''',a,'''', &
3403 & t72,a,2x,'Grid ',i2.2,/, &
3404 & 19x,'(Cmin = ', 1p,e15.8,0p,' Cmax = ',1p,e15.8,0p,')')
3405 30 FORMAT ('regcm',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
3406 & i2.2,2('.',i2.2),'.nc')
3407
3408 RETURN