ROMS
Loading...
Searching...
No Matches
Functions/Subroutines | Variables
esmf_roms_mod Module Reference

Functions/Subroutines

subroutine, public ice_setservices (model, rc)
 
subroutine, private cice_setinitializep1 (model, importstate, exportstate, clock, rc)
 
subroutine, private cice_setinitializep2 (model, importstate, exportstate, clock, rc)
 
subroutine, private cice_datainit (model, rc)
 
subroutine, private cice_setclock (model, rc)
 
subroutine, private cice_setgridarrays (ng, model, rc)
 
subroutine, private cice_setstates (ng, model, rc)
 
subroutine, private cice_modeladvance (model, rc)
 
subroutine, private cice_setfinalize (model, importstate, exportstate, clock, rc)
 
subroutine, private cice_import (ng, model, rc)
 
subroutine, private cice_export (ng, model, rc)
 
subroutine, public roms_setservices (model, rc)
 
subroutine, private roms_setinitializep1 (model, importstate, exportstate, clock, rc)
 
subroutine, private roms_setinitializep2 (model, importstate, exportstate, clock, rc)
 
subroutine, private roms_datainit (model, rc)
 
subroutine, private roms_setclock (model, rc)
 
subroutine, private roms_setrunclock (model, rc)
 
subroutine, private roms_checkimport (model, rc)
 
subroutine, private roms_setgridarrays (ng, tile, model, rc)
 
subroutine, private roms_setstates (ng, tile, model, rc)
 
subroutine, private roms_modeladvance (model, rc)
 
subroutine, private roms_setfinalize (model, importstate, exportstate, clock, rc)
 
subroutine, private roms_import (ng, model, rc)
 
subroutine, private roms_export (ng, model, rc)
 
subroutine, private roms_rotate (ng, tile, lrotate, lbi, ubi, lbj, ubj, uinp, vinp, uout, vout)
 

Variables

integer, parameter geo2grid = 0
 
integer, parameter geo2grid_rho = 0
 
integer, parameter grid2geo_rho = 1
 

Function/Subroutine Documentation

◆ cice_datainit()

subroutine, private esmf_roms_mod::cice_datainit ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 500 of file esmf_ice_cice.h.

501!
502!=======================================================================
503! !
504! Exports CICE component fields during initialization or restart. !
505! !
506!=======================================================================
507!
508! Imported variable declarations.
509!
510 integer, intent(out) :: rc
511!
512 TYPE (ESMF_GridComp) :: model
513!
514! Local variable declarations.
515!
516 integer :: ng
517!
518 character (len=*), parameter :: MyFile = &
519 & __FILE__//", CICE_DataInit"
520!
521 TYPE (ESMF_Time) :: CurrentTime
522!
523!-----------------------------------------------------------------------
524! Initialize return code flag to success state (no error).
525!-----------------------------------------------------------------------
526!
527 IF (esm_track) THEN
528 WRITE (trac,'(a,a,i0)') '==> Entering CICE_DataInit', &
529 & ', PET', petrank
530 FLUSH (trac)
531 END IF
532 rc=esmf_success
533!
534!-----------------------------------------------------------------------
535! Get gridded component clock current time.
536!-----------------------------------------------------------------------
537!
538 CALL esmf_clockget (clockinfo(iseaice)%Clock, &
539 & currtime=currenttime, &
540 & rc=rc)
541 IF (esmf_logfounderror(rctocheck=rc, &
542 & msg=esmf_logerr_passthru, &
543 & line=__line__, &
544 & file=myfile)) THEN
545 RETURN
546 END IF
547!
548!-----------------------------------------------------------------------
549! Export initialization or restart fields.
550!-----------------------------------------------------------------------
551!
552! Run CICE component only for one time-step to fill variables.
553!
554 CALL cice_run ()
555!
556! Put export fields.
557!
558 IF (nexport(iseaice).gt.0) THEN
559 DO ng=1,models(iseaice)%Ngrids
560 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
561 CALL cice_export (ng, model, rc)
562 IF (esmf_logfounderror(rctocheck=rc, &
563 & msg=esmf_logerr_passthru, &
564 & line=__line__, &
565 & file=myfile)) THEN
566 RETURN
567 END IF
568 END IF
569 END DO
570 END IF
571!
572 IF (esm_track) THEN
573 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_DataInit', &
574 & ', PET', petrank
575 FLUSH (trac)
576 END IF
577!
578 RETURN

References cice_export(), mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, mod_esmf_esm::esm_track, mod_esmf_esm::iseaice, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by ice_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ cice_export()

subroutine, private esmf_roms_mod::cice_export ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 2853 of file esmf_ice_cice.h.

2854!
2855!=======================================================================
2856! !
2857! Exports CICE fields to other coupled gridded components. !
2858! !
2859!=======================================================================
2860!
2861 USE ice_blocks, ONLY : block
2862 USE ice_blocks, ONLY : get_block
2863 USE ice_constants, ONLY : tffresh
2864 USE ice_domain, ONLY : nblocks, blocks_ice
2865 USE ice_grid, ONLY : hm, anglet
2866 USE ice_flux
2867!
2868! Imported variable declarations.
2869!
2870 integer, intent(in) :: ng
2871 integer, intent(out) :: rc
2872!
2873 TYPE (ESMF_GridComp) :: model
2874!
2875! Local variable declarations.
2876!
2877 integer :: id, ifld
2878 integer :: blk, i, ii, j, jj
2879 integer :: ExportCount
2880 integer :: localPET
2881 integer :: year, month, day, hour, minutes, seconds, sN, SD
2882!
2883 real (dp) :: Fmin(1), Fmax(1), Fval, MyFmin(1), MyFmax(1)
2884 real (dp) :: wdir
2885!
2886 real (dp), pointer :: ptr3d(:,:,:) => null()
2887!
2888 character (len=22) :: Time_CurrentString
2889
2890 character (len=*), parameter :: MyFile = &
2891 & __FILE__//", CICE_Export"
2892
2893 character (ESMF_MAXSTR) :: cname, ofile
2894 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
2895!
2896 TYPE (block) :: my_block
2897 TYPE (ESMF_Field) :: field
2898 TYPE (ESMF_Time) :: CurrentTime
2899 TYPE (ESMF_VM) :: vm
2900!
2901!-----------------------------------------------------------------------
2902! Initialize return code flag to success state (no error).
2903!-----------------------------------------------------------------------
2904!
2905 IF (esm_track) THEN
2906 WRITE (trac,'(a,a,i0)') '==> Entering CICE_Export', &
2907 & ', PET', petrank
2908 FLUSH (trac)
2909 END IF
2910 rc=esmf_success
2911!
2912!-----------------------------------------------------------------------
2913! Get information about the gridded component.
2914!-----------------------------------------------------------------------
2915!
2916 CALL esmf_gridcompget (model, &
2917 & localpet=localpet, &
2918 & vm=vm, &
2919 & name=cname, &
2920 & rc=rc)
2921 IF (esmf_logfounderror(rctocheck=rc, &
2922 & msg=esmf_logerr_passthru, &
2923 & line=__line__, &
2924 & file=myfile)) THEN
2925 RETURN
2926 END IF
2927!
2928!-----------------------------------------------------------------------
2929! Get current time.
2930!-----------------------------------------------------------------------
2931!
2932 CALL esmf_clockget (clockinfo(iseaice)%Clock, &
2933 & currtime=currenttime, &
2934 & rc=rc)
2935 IF (esmf_logfounderror(rctocheck=rc, &
2936 & msg=esmf_logerr_passthru, &
2937 & line=__line__, &
2938 & file=myfile)) THEN
2939 RETURN
2940 END IF
2941!
2942 CALL esmf_timeget (currenttime, &
2943 & yy=year, &
2944 & mm=month, &
2945 & dd=day, &
2946 & h =hour, &
2947 & m =minutes, &
2948 & s =seconds, &
2949 & sn=sn, &
2950 & sd=sd, &
2951 & timestring=time_currentstring, &
2952 & rc=rc)
2953 IF (esmf_logfounderror(rctocheck=rc, &
2954 & msg=esmf_logerr_passthru, &
2955 & line=__line__, &
2956 & file=myfile)) THEN
2957 RETURN
2958 END IF
2959 is=index(time_currentstring, 'T') ! remove 'T' in
2960 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2961!
2962!-----------------------------------------------------------------------
2963! Get list of export fields.
2964!-----------------------------------------------------------------------
2965!
2966 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
2967 & itemcount=exportcount, &
2968 & rc=rc)
2969 IF (esmf_logfounderror(rctocheck=rc, &
2970 & msg=esmf_logerr_passthru, &
2971 & line=__line__, &
2972 & file=myfile)) THEN
2973 RETURN
2974 END IF
2975!
2976 IF (.not. allocated(exportnamelist)) THEN
2977 allocate ( exportnamelist(exportcount) )
2978 END IF
2979!
2980 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
2981 & itemnamelist=exportnamelist, &
2982 & rc=rc)
2983 IF (esmf_logfounderror(rctocheck=rc, &
2984 & msg=esmf_logerr_passthru, &
2985 & line=__line__, &
2986 & file=myfile)) THEN
2987 RETURN
2988 END IF
2989!
2990!-----------------------------------------------------------------------
2991! Load export fields.
2992!-----------------------------------------------------------------------
2993!
2994 fld_loop : DO ifld=1,exportcount
2995!
2996! Get field from export state.
2997!
2998 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
2999 & trim(exportnamelist(ifld)), &
3000 & field, &
3001 & rc=rc)
3002 IF (esmf_logfounderror(rctocheck=rc, &
3003 & msg=esmf_logerr_passthru, &
3004 & line=__line__, &
3005 & file=myfile)) THEN
3006 RETURN
3007 END IF
3008!
3009! Get field pointer.
3010!
3011 CALL esmf_fieldget (field, &
3012 & farrayptr=ptr3d, &
3013 & rc=rc)
3014 IF (esmf_logfounderror(rctocheck=rc, &
3015 & msg=esmf_logerr_passthru, &
3016 & line=__line__, &
3017 & file=myfile)) THEN
3018 RETURN
3019 END IF
3020!
3021! Initialize pointer to missing value.
3022!
3023 ptr3d=missing_dp
3024 fmin(1)= missing_dp
3025 tmax(1)=-missing_dp
3026!
3027! Load field data into export state.
3028!
3029 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
3030!
3031! Ice mask at cell center (T-cell), computed from land-boundary mask.
3032!
3033 CASE ('mask', 'hm', 'ice_mask')
3034 DO blk=1,nblocks
3035 my_block=get_block(blocks_ice(blk), blk)
3036 DO j=my_block%jlo,my_block%jhi
3037 jj=j-my_block%jlo+1
3038 DO i=my_block%ilo,my_block%ihi
3039 ii=i-my_block%ilo+1
3040 IF (hm(i,j,blk).gt.0.5_dp) THEN
3041 ptr3d(ii,jj,blk)=1.0_dp
3042 ELSE
3043 ptr3d(ii,jj,blk)=0.0_dp
3044 END IF
3045 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3046 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3047 END DO
3048 END DO
3049 END DO
3050!
3051! Fractional ice area (nondimensional; 0.0 - 1.0).
3052!
3053 CASE ('ifrac', 'ice_fraction')
3054 DO blk=1,nblocks
3055 my_block=get_block(blocks_ice(blk), blk)
3056 DO j=my_block%jlo,my_block%jhi
3057 jj=j-my_block%jlo+1
3058 DO i=my_block%ilo,my_block%ihi
3059 ii=i-my_block%ilo+1
3060 ptr3d(ii,jj,blk)=aice(i,j,blk)
3061 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3062 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3063 END DO
3064 END DO
3065 END DO
3066!
3067! Surface temperature of ice/snow covered portion (K), to ATM.
3068!
3069 CASE ('sit', 'sea_ice_temperature')
3070 DO blk=1,nblocks
3071 my_block=get_block(blocks_ice(blk), blk)
3072 DO j=my_block%jlo,my_block%jhi
3073 jj=j-my_block%jlo+1
3074 DO i=my_block%ilo,my_block%ihi
3075 ii=i-my_block%ilo+1
3076 IF (aice(i,j,blk).gt.0.0_dp) THEN
3077 ptr3d(ii,jj,blk)=tffresh+trcr(i,j,1,blk)
3078 ELSE
3079 ptr3d(ii,jj,blk)=0.0_dp
3080 END IF
3081 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3082 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3083 END DO
3084 END DO
3085 END DO
3086!
3087! Fraction of visible band, direct albedo aggregated over ice
3088! categories (nondimesional), to ATM.
3089!
3090 CASE ('alvdr', 'inst_ice_vis_dir_albedo')
3091 DO blk=1,nblocks
3092 my_block=get_block(blocks_ice(blk), blk)
3093 DO j=my_block%jlo,my_block%jhi
3094 jj=j-my_block%jlo+1
3095 DO i=my_block%ilo,my_block%ihi
3096 ii=i-my_block%ilo+1
3097 ptr3d(ii,jj,blk)=alvdr(i,j,blk)
3098 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3099 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3100 END DO
3101 END DO
3102 END DO
3103!
3104! Fraction of visible band, diffusive albedo aggregated over ice
3105! categories (nondimesional), to ATM.
3106!
3107 CASE ('alvdf', 'inst_ice_vis_dif_albedo')
3108 DO blk=1,nblocks
3109 my_block=get_block(blocks_ice(blk), blk)
3110 DO j=my_block%jlo,my_block%jhi
3111 jj=j-my_block%jlo+1
3112 DO i=my_block%ilo,my_block%ihi
3113 ii=i-my_block%ilo+1
3114 ptr3d(ii,jj,blk)=alvdf(i,j,blk)
3115 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3116 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3117 END DO
3118 END DO
3119 END DO
3120!
3121! Fraction of near-infrared band, direct albedo aggregated over
3122! ice categories (nondimesional), to ATM.
3123!
3124 CASE ('alidr', 'inst_ice_ir_dir_albedo')
3125 DO blk=1,nblocks
3126 my_block=get_block(blocks_ice(blk), blk)
3127 DO j=my_block%jlo,my_block%jhi
3128 jj=j-my_block%jlo+1
3129 DO i=my_block%ilo,my_block%ihi
3130 ii=i-my_block%ilo+1
3131 ptr3d(ii,jj,blk)=alidr(i,j,blk)
3132 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3133 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3134 END DO
3135 END DO
3136 END DO
3137!
3138! Fraction of near-infrared band, diffusive albedo aggregated over
3139! ice categories (nondimesional), to ATM.
3140!
3141 CASE ('alidf', 'inst_ice_ir_dif_albedo')
3142 DO blk=1,nblocks
3143 my_block=get_block(blocks_ice(blk), blk)
3144 DO j=my_block%jlo,my_block%jhi
3145 jj=j-my_block%jlo+1
3146 DO i=my_block%ilo,my_block%ihi
3147 ii=i-my_block%ilo+1
3148 ptr3d(ii,jj,blk)=alidf(i,j,blk)
3149 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3150 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3151 END DO
3152 END DO
3153 END DO
3154!
3155! Shortwave flux penetrating through ice to ocean (W m-2), to OCN.
3156!
3157 CASE ('fswthru', 'sw_pen_to_ocean')
3158 DO blk=1,nblocks
3159 my_block=get_block(blocks_ice(blk), blk)
3160 DO j=my_block%jlo,my_block%jhi
3161 jj=j-my_block%jlo+1
3162 DO i=my_block%ilo,my_block%ihi
3163 ii=i-my_block%ilo+1
3164 ptr3d(ii,jj,blk)=fswthru(i,j,blk)
3165 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3166 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3167 END DO
3168 END DO
3169 END DO
3170!
3171! Visible direct band of net shortwave flux penetrating through
3172! ice to ocean (W m-2), to OCN.
3173!
3174 CASE ('fswthruvdr', 'net_sw_vis_dir_flx')
3175 DO blk=1,nblocks
3176 my_block=get_block(blocks_ice(blk), blk)
3177 DO j=my_block%jlo,my_block%jhi
3178 jj=j-my_block%jlo+1
3179 DO i=my_block%ilo,my_block%ihi
3180 ii=i-my_block%ilo+1
3181 ptr3d(ii,jj,blk)=fswthruvdr(i,j,blk)
3182 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3183 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3184 END DO
3185 END DO
3186 END DO
3187!
3188! Visible diffusive band of net shortwave flux penetrating through
3189! ice to ocean (W m-2), to OCN.
3190!
3191 CASE ('fswthruvdf', 'net_sw_vis_dif_flx')
3192 DO blk=1,nblocks
3193 my_block=get_block(blocks_ice(blk), blk)
3194 DO j=my_block%jlo,my_block%jhi
3195 jj=j-my_block%jlo+1
3196 DO i=my_block%ilo,my_block%ihi
3197 ii=i-my_block%ilo+1
3198 ptr3d(ii,jj,blk)=fswthruvdf(i,j,blk)
3199 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3200 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3201 END DO
3202 END DO
3203 END DO
3204!
3205! Infrared direct band of net shortwave flux penetrating through
3206! ice to ocean (W m-2), to OCN.
3207!
3208 CASE ('fswthruidr', 'net_sw_ir_dir_flx')
3209 DO blk=1,nblocks
3210 my_block=get_block(blocks_ice(blk), blk)
3211 DO j=my_block%jlo,my_block%jhi
3212 jj=j-my_block%jlo+1
3213 DO i=my_block%ilo,my_block%ihi
3214 ii=i-my_block%ilo+1
3215 ptr3d(ii,jj,blk)=fswthruidr(i,j,blk)
3216 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3217 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3218 END DO
3219 END DO
3220 END DO
3221!
3222! Infrared diffusive band of net shortwave flux penetrating through
3223! ice to ocean (W m-2), to OCN.
3224!
3225 CASE ('fswthruidf', 'net_sw_ir_dif_flx')
3226 DO blk=1,nblocks
3227 my_block=get_block(blocks_ice(blk), blk)
3228 DO j=my_block%jlo,my_block%jhi
3229 jj=j-my_block%jlo+1
3230 DO i=my_block%ilo,my_block%ihi
3231 ii=i-my_block%ilo+1
3232 ptr3d(ii,jj,blk)=fswthruidf(i,j,blk)
3233 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3234 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3235 END DO
3236 END DO
3237 END DO
3238!
3239! Outgoing upward longwave ratiation (W m-2), averaged over ice
3240! fraction only, to ATM.
3241!
3242 CASE ('flwout', 'mean_up_lw_flx_ice')
3243 DO blk=1,nblocks
3244 my_block=get_block(blocks_ice(blk), blk)
3245 DO j=my_block%jlo,my_block%jhi
3246 jj=j-my_block%jlo+1
3247 DO i=my_block%ilo,my_block%ihi
3248 ii=i-my_block%ilo+1
3249 ptr3d(ii,jj,blk)=flwout(i,j,blk)
3250 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3251 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3252 END DO
3253 END DO
3254 END DO
3255!
3256! Ice sensible heat flux (W m-2), to ATM.
3257!
3258 CASE ('fsens', 'mean_sensi_heat_flx_atm_into_ice')
3259 DO blk=1,nblocks
3260 my_block=get_block(blocks_ice(blk), blk)
3261 DO j=my_block%jlo,my_block%jhi
3262 jj=j-my_block%jlo+1
3263 DO i=my_block%ilo,my_block%ihi
3264 ii=i-my_block%ilo+1
3265 ptr3d(ii,jj,blk)=fsens(i,j,blk)
3266 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3267 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3268 END DO
3269 END DO
3270 END DO
3271!
3272! Ice latent heat flux (W m-2), to ATM.
3273!
3274 CASE ('flat', 'mean_laten_heat_flx_atm_into_ice')
3275 DO blk=1,nblocks
3276 my_block=get_block(blocks_ice(blk), blk)
3277 DO j=my_block%jlo,my_block%jhi
3278 jj=j-my_block%jlo+1
3279 DO i=my_block%ilo,my_block%ihi
3280 ii=i-my_block%ilo+1
3281 ptr3d(ii,jj,blk)=flat(i,j,blk)
3282 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3283 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3284 END DO
3285 END DO
3286 END DO
3287!
3288! Evaporative water flux (kg m-2 s-1), to ATM.
3289!
3290 CASE ('evap', 'mean_evap_rate_atm_into_ice')
3291 DO blk=1,nblocks
3292 my_block=get_block(blocks_ice(blk), blk)
3293 DO j=my_block%jlo,my_block%jhi
3294 jj=j-my_block%jlo+1
3295 DO i=my_block%ilo,my_block%ihi
3296 ii=i-my_block%ilo+1
3297 ptr3d(ii,jj,blk)=evap(i,j,blk)
3298 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3299 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3300 END DO
3301 END DO
3302 END DO
3303!
3304! Net heat flux to ocean (W m-2), to OCN.
3305!
3306 CASE ('fhocn', 'net_heat_flx_to_ocn')
3307 DO blk=1,nblocks
3308 my_block=get_block(blocks_ice(blk), blk)
3309 DO j=my_block%jlo,my_block%jhi
3310 jj=j-my_block%jlo+1
3311 DO i=my_block%ilo,my_block%ihi
3312 ii=i-my_block%ilo+1
3313 ptr3d(ii,jj,blk)=fhocn(i,j,blk)
3314 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3315 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3316 END DO
3317 END DO
3318 END DO
3319!
3320! Fresh water flux to ocean (kg m-2 s-1), to OCN.
3321!
3322 CASE ('fresh', 'fresh_water_flx_to_ocean')
3323 DO blk=1,nblocks
3324 my_block=get_block(blocks_ice(blk), blk)
3325 DO j=my_block%jlo,my_block%jhi
3326 jj=j-my_block%jlo+1
3327 DO i=my_block%ilo,my_block%ihi
3328 ii=i-my_block%ilo+1
3329 ptr3d(ii,jj,blk)=fresh(i,j,blk)
3330 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3331 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3332 END DO
3333 END DO
3334 END DO
3335!
3336! Salt flux to ocean (kg m-2 s-1), to OCN.
3337!
3338 CASE ('fsalt', 'salt_flx_to_ocean')
3339 DO blk=1,nblocks
3340 my_block=get_block(blocks_ice(blk), blk)
3341 DO j=my_block%jlo,my_block%jhi
3342 jj=j-my_block%jlo+1
3343 DO i=my_block%ilo,my_block%ihi
3344 ii=i-my_block%ilo+1
3345 ptr3d(ii,jj,blk)=fsalt(i,j,blk)
3346 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3347 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3348 END DO
3349 END DO
3350 END DO
3351!
3352! Ice volume per unit area (m).
3353!
3354 CASE ('vice', 'mean_ice_volume')
3355 DO blk=1,nblocks
3356 my_block=get_block(blocks_ice(blk), blk)
3357 DO j=my_block%jlo,my_block%jhi
3358 jj=j-my_block%jlo+1
3359 DO i=my_block%ilo,my_block%ihi
3360 ii=i-my_block%ilo+1
3361 ptr3d(ii,jj,blk)=vice(i,j,blk)
3362 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3363 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3364 END DO
3365 END DO
3366 END DO
3367!
3368! Snow volume per unit area (m).
3369!
3370 CASE ('vsno', 'mean_snow_volume')
3371 DO blk=1,nblocks
3372 my_block=get_block(blocks_ice(blk), blk)
3373 DO j=my_block%jlo,my_block%jhi
3374 jj=j-my_block%jlo+1
3375 DO i=my_block%ilo,my_block%ihi
3376 ii=i-my_block%ilo+1
3377 ptr3d(ii,jj,blk)=vsno(i,j,blk)
3378 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3379 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3380 END DO
3381 END DO
3382 END DO
3383!
3384! Zonal stress on ice by air (N m-2), to ATM.
3385!
3386 CASE ('strairxT', 'stress_on_air_ice_zonal')
3387 DO blk=1,nblocks
3388 my_block=get_block(blocks_ice(blk), blk)
3389 DO j=my_block%jlo,my_block%jhi
3390 jj=j-my_block%jlo+1
3391 DO i=my_block%ilo,my_block%ihi
3392 ii=i-my_block%ilo+1
3393 ui=strairxt(i,j,blk)
3394 vj=strairyt(i,j,blk)
3395 ptr3d(ii,jj,blk)=ui*cos(anglet(i,j,blk))- &
3396 & vj*sin(anglet(i,j,blk))
3397 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3398 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3399 END DO
3400 END DO
3401 END DO
3402!
3403! Meridional stress on ice by air (N m-2), to ATM.
3404!
3405 CASE ('strairyT', 'stress_on_air_ice_merid')
3406 DO blk=1,nblocks
3407 my_block=get_block(blocks_ice(blk), blk)
3408 DO j=my_block%jlo,my_block%jhi
3409 jj=j-my_block%jlo+1
3410 DO i=my_block%ilo,my_block%ihi
3411 ii=i-my_block%ilo+1
3412 ui=strairxt(i,j,blk)
3413 vj=strairyt(i,j,blk)
3414 ptr3d(ii,jj,blk)=ui*sin(anglet(i,j,blk))+ &
3415 & vj*cos(anglet(i,j,blk))
3416 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3417 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3418 END DO
3419 END DO
3420 END DO
3421!
3422! Zonal stress on ice by ocean (N m-2), to OCN.
3423!
3424 CASE ('strocnxT', 'stress_on_ocn_ice_zonal')
3425 DO blk=1,nblocks
3426 my_block=get_block(blocks_ice(blk), blk)
3427 DO j=my_block%jlo,my_block%jhi
3428 jj=j-my_block%jlo+1
3429 DO i=my_block%ilo,my_block%ihi
3430 ii=i-my_block%ilo+1
3431 ui=-strocnxt(i,j,blk)
3432 vj=-strocnyt(i,j,blk)
3433 ptr3d(ii,jj,blk)=ui*cos(anglet(i,j,blk))- &
3434 & vj*sin(anglet(i,j,blk))
3435 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3436 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3437 END DO
3438 END DO
3439 END DO
3440!
3441! Meridional stress on ice by ocean (N m-2), to OCN.
3442!
3443 CASE ('strocnyT', 'stress_on_ocn_ice_merid')
3444 DO blk=1,nblocks
3445 my_block=get_block(blocks_ice(blk), blk)
3446 DO j=my_block%jlo,my_block%jhi
3447 jj=j-my_block%jlo+1
3448 DO i=my_block%ilo,my_block%ihi
3449 ii=i-my_block%ilo+1
3450 ui=-strocnxt(i,j,blk)
3451 vj=-strocnyt(i,j,blk)
3452 ptr(ii,jj,blk)=ui*sin(anglet(i,j,blk))+ &
3453 & vj*cos(anglet(i,j,blk))
3454 END DO
3455 END DO
3456 END DO
3457!
3458! Export field not found.
3459!
3460 CASE DEFAULT
3461 IF (localpet.eq.0) THEN
3462 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
3463 & trim(cinpname)
3464 END IF
3465 rc=esmf_rc_not_found
3466 IF (esmf_logfounderror(rctocheck=rc, &
3467 & msg=esmf_logerr_passthru, &
3468 & line=__line__, &
3469 & file=myfile)) THEN
3470 RETURN
3471 END IF
3472 END SELECT
3473!
3474! Nullify pointer to make sure that it does not point on a random
3475! part in the memory.
3476!
3477 IF (associated(ptr3d)) nullify (ptr3d)
3478 END DO de_loop
3479!
3480! Get export field minimun and maximum values.
3481!
3482 CALL esmf_vmallreduce (vm, &
3483 & senddata=myfmin, &
3484 & recvdata=fmin, &
3485 & count=1, &
3486 & reduceflag=esmf_reduce_min, &
3487 & rc=rc)
3488 IF (esmf_logfounderror(rctocheck=rc, &
3489 & msg=esmf_logerr_passthru, &
3490 & line=__line__, &
3491 & file=myfile)) THEN
3492 RETURN
3493 END IF
3494!
3495 CALL esmf_vmallreduce (vm, &
3496 & senddata=myfmax, &
3497 & recvdata=fmax, &
3498 & count=1, &
3499 & reduceflag=esmf_reduce_max, &
3500 & rc=rc)
3501 IF (esmf_logfounderror(rctocheck=rc, &
3502 & msg=esmf_logerr_passthru, &
3503 & line=__line__, &
3504 & file=myfile)) THEN
3505 RETURN
3506 END IF
3507!
3508 IF (localpet.eq.0) THEN
3509 WRITE (cplout,20) trim(exportnamelist(ifld)), &
3510 & trim(time_currentstring), ng, &
3511 & fmin(1), fmax(1)
3512 END IF
3513!
3514! Debugging: write out field into a NetCDF file.
3515!
3516 IF ((debuglevel.ge.3).and. &
3517 & models(iseaice)%ExportField(ifld)%debug_write) THEN
3518 WRITE (ofile,10) ng, trim(exportnamelist(ifld)), &
3519 & year, month, day, hour, minutes, seconds
3520 CALL esmf_fieldwrite (field, &
3521 & trim(ofile), &
3522 & overwrite=.true., &
3523 & rc=rc)
3524 IF (esmf_logfounderror(rctocheck=rc, &
3525 & msg=esmf_logerr_passthru, &
3526 & line=__line__, &
3527 & file=myfile)) THEN
3528 RETURN
3529 END IF
3530 END IF
3531 END DO fld_loop
3532!
3533! Deallocate local arrays.
3534!
3535 IF (allocated(exportnamelist)) deallocate (exportnamelist)
3536!
3537! Update CICE export calls counter.
3538!
3539 IF (exportcount.gt.0) THEN
3540 models(iseaice)%ExportCalls=models(iseaice)%ExportCalls+1
3541 END IF
3542!
3543 IF (esm_track) THEN
3544 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_Export', &
3545 & ', PET', petrank
3546 FLUSH (trac)
3547 END IF
3548 FLUSH (cplout)
3549!
3550 10 FORMAT (/,3x,' CICE_Export - unable to find option to export: ', &
3551 & a,/,18x,'check ''Export(cice)'' in input script: ',a)
3552 20 FORMAT (3x,' CICE_Export - ESMF: exporting field ''',a,'''', &
3553 & t72,a,2x,'Grid ',i2.2,/, &
3554 & 18x,'(Cmin = ', 1p,e15.8,0p,' Cmax = ',1p,e15.8,0p,')')
3555 30 FORMAT ('cice_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
3556 & i2.2,2('.',i2.2),'.nc')
3557
3558 RETURN

References mod_esmf_esm::cinpname, mod_esmf_esm::clockinfo, mod_esmf_esm::cplout, mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, mod_esmf_esm::iseaice, mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by cice_datainit(), and cice_modeladvance().

Here is the caller graph for this function:

◆ cice_import()

subroutine, private esmf_roms_mod::cice_import ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1923 of file esmf_ice_cice.h.

1924!
1925!=======================================================================
1926! !
1927! Imports fields into CICE array structure from other coupled !
1928! gridded components. !
1929! !
1930!=======================================================================
1931!
1932 USE ice_blocks, ONLY : block
1933 USE ice_blocks, ONLY : get_block
1934 USE ice_domain, ONLY : nblocks, blocks_ice
1935 USE ice_domain_size, ONLY : max_blocks, nx_global, ny_global
1936 USE ice_grid, ONLY : anglet
1937 USE ice_flux
1938!
1939! Imported variable declarations.
1940!
1941 integer, intent(in) :: ng
1942 integer, intent(out) :: rc
1943!
1944 TYPE (ESMF_GridComp) :: model
1945!
1946! Local variable declarations.
1947!
1948 logical :: got_pair, got_tair
1949 logical :: got_current(2), got_swfx(4), got_wind(2), got_wstr(2)
1950!
1951 integer :: id, ifld
1952 integer :: blk, i, ii, j, jj
1953 integer :: iyear, iday, imonth, ihour
1954 integer :: ImportCount
1955 integer :: localPET
1956 integer :: year, month, day, hour, minutes, seconds, sN, SD
1957!
1958 real (dp) :: ciceScale, scale, add_offset
1959 real (dp) :: TimeInDays, Time_Current, Tmin, Tmax, Tstr, Tend
1960 real (dp) :: sigma_c, sigma_l, sigma_r, slopex, slopey
1961!
1962 real (dp), dimension(nx_global,ny_global,max_blocks) :: Pair
1963!
1964 real (dp), pointer :: ptr3d(:,:,:) => null()
1965!
1966 character (len=*), parameter :: MyFile = &
1967 & __FILE__//", CICE_Import"
1968
1969 character (ESMF_MAXSTR) :: ofile
1970 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
1971!
1972 TYPE (block) :: my_block
1973 TYPE (ESMF_Clock) :: clock
1974 TYPE (ESMF_Field) :: field
1975 TYPE (ESMF_Time) :: CurrentTime
1976 TYPE (ESMF_VM) :: vm
1977!
1978!-----------------------------------------------------------------------
1979! Initialize return code flag to success state (no error).
1980!-----------------------------------------------------------------------
1981!
1982 IF (esm_track) THEN
1983 WRITE (trac,'(a,a,i0)') '==> Entering CICE_Import', &
1984 & ', PET', petrank
1985 FLUSH (trac)
1986 END IF
1987 rc=esmf_success
1988!
1989!-----------------------------------------------------------------------
1990! Get information about the gridded component.
1991!-----------------------------------------------------------------------
1992!
1993 CALL esmf_gridcompget (model, &
1994 & clock=clock, &
1995 & localpet=localpet, &
1996 & vm=vm, &
1997 & rc=rc)
1998 IF (esmf_logfounderror(rctocheck=rc, &
1999 & msg=esmf_logerr_passthru, &
2000 & line=__line__, &
2001 & file=myfile)) THEN
2002 RETURN
2003 END IF
2004!
2005!-----------------------------------------------------------------------
2006! Get current time.
2007!-----------------------------------------------------------------------
2008!
2009 CALL esmf_clockget (clock, &
2010 & currtime=currenttime, &
2011 & rc=rc)
2012 IF (esmf_logfounderror(rctocheck=rc, &
2013 & msg=esmf_logerr_passthru, &
2014 & line=__line__, &
2015 & file=myfile)) THEN
2016 RETURN
2017 END IF
2018!
2019 CALL esmf_timeget (currenttime, &
2020 & yy=year, &
2021 & mm=month, &
2022 & dd=day, &
2023 & h =hour, &
2024 & m =minutes, &
2025 & s =seconds, &
2026 & sn=sn, &
2027 & sd=sd, &
2028 & rc=rc)
2029 IF (esmf_logfounderror(rctocheck=rc, &
2030 & msg=esmf_logerr_passthru, &
2031 & line=__line__, &
2032 & file=myfile)) THEN
2033 RETURN
2034 END IF
2035!
2036 CALL esmf_timeget (currenttime, &
2037 & s_r8=time_current, &
2038 & timestring=time_currentstring, &
2039 & rc=rc)
2040 IF (esmf_logfounderror(rctocheck=rc, &
2041 & msg=esmf_logerr_passthru, &
2042 & line=__line__, &
2043 & file=myfile)) THEN
2044 RETURN
2045 END IF
2046 timeindays=time_current/86400.0_dp
2047 is=index(time_currentstring, 'T') ! remove 'T' in
2048 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2049!
2050!-----------------------------------------------------------------------
2051! Get list of import fields.
2052!-----------------------------------------------------------------------
2053!
2054 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
2055 & itemcount=importcount, &
2056 & rc=rc)
2057 IF (esmf_logfounderror(rctocheck=rc, &
2058 & msg=esmf_logerr_passthru, &
2059 & line=__line__, &
2060 & file=myfile)) THEN
2061 RETURN
2062 END IF
2063!
2064 IF (.not.allocated(importnamelist)) THEN
2065 allocate ( importnamelist(importcount) )
2066 END IF
2067 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
2068 & itemnamelist=importnamelist, &
2069 & rc=rc)
2070 IF (esmf_logfounderror(rctocheck=rc, &
2071 & msg=esmf_logerr_passthru, &
2072 & line=__line__, &
2073 & file=myfile)) THEN
2074 RETURN
2075 END IF
2076!
2077!-----------------------------------------------------------------------
2078! Get import fields.
2079!-----------------------------------------------------------------------
2080!
2081 got_pair=.false.
2082 got_tair=.false.
2083 got_current(1:2)=.false.
2084 got_swfx(1:4)=.false.
2085 got_wind(1:2)=.false.
2086 got_wstr(1:2)=.false.
2087!
2088 fld_loop : DO ifld=1,importcount
2089 id=field_index(models(iseaice)%ImportField,importnamelist(ifld))
2090!
2091! Get field from import state.
2092!
2093 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
2094 & trim(importnamelist(ifld)), &
2095 & field, &
2096 & rc=rc)
2097 IF (esmf_logfounderror(rctocheck=rc, &
2098 & msg=esmf_logerr_passthru, &
2099 & line=__line__, &
2100 & file=myfile)) THEN
2101 RETURN
2102 END IF
2103!
2104! Get field pointer.
2105!
2106 CALL esmf_fieldget (field, &
2107 & farrayptr=ptr3d, &
2108 & rc=rc)
2109 IF (esmf_logfounderror(rctocheck=rc, &
2110 & msg=esmf_logerr_passthru, &
2111 & line=__line__, &
2112 & file=myfile)) THEN
2113 RETURN
2114 END IF
2115!
2116! Load import data into CICE component variable.
2117!
2118 scale=models(iseaice)%ImportField(id)%scale_factor
2119 add_offset=models(iseaice)%ImportField(id)%add_offset
2120!
2121 myfmin(1)= missing_dp
2122 myfmax(1)=-missing_dp
2123 myfmin(2)= missing_dp
2124 myfmax(2)=-missing_dp
2125!
2126 SELECT CASE (trim(adjustl(itemnamelist(ifld))))
2127!
2128! Atmospheric height of the lowest level (m), from ATM.
2129!
2130 CASE ('zlvl', 'inst_height_lowest')
2131 DO blk=1,nblocks
2132 my_block=get_block(blocks_ice(blk), blk)
2133 DO j=my_block%jlo,my_block%jhi
2134 jj=j-my_block%jlo+1
2135 DO i=my_block%ilo,my_block%ihi
2136 ii=i-my_block%ilo+1
2137 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2138 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2139 fval=scale*ptr3d(ii,jj,blk)+add_offset
2140 myfmin(2)=min(myfmin(2),fval)
2141 myfmax(2)=max(myfmax(2),fval)
2142 zlvl(i,j,blk)=fval
2143 END DO
2144 END DO
2145 END DO
2146!
2147! Air density (kg m-3) at surface defined by inst_height_lowest (near
2148! surface; maybe lowest level), from ATM.
2149!
2150 CASE ('rhoa', 'air_density_height_lowest')
2151 DO blk=1,nblocks
2152 my_block=get_block(blocks_ice(blk), blk)
2153 DO j=my_block%jlo,my_block%jhi
2154 jj=j-my_block%jlo+1
2155 DO i=my_block%ilo,my_block%ihi
2156 ii=i-my_block%ilo+1
2157 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2158 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2159 fval=scale*ptr3d(ii,jj,blk)+add_offset
2160 myfmin(2)=min(myfmin(2),fval)
2161 myfmax(2)=max(myfmax(2),fval)
2162 rhoa(i,j,blk)=fval
2163 END DO
2164 END DO
2165 END DO
2166!
2167! Air pressure (N m-2) at surface defined by inst_height_lowest (near
2168! surface; maybe lowest level), from ATM.
2169!
2170 CASE ('Pair', 'ips', 'inst_pres_height_lowest')
2171 DO blk=1,nblocks
2172 my_block=get_block(blocks_ice(blk), blk)
2173 DO j=my_block%jlo,my_block%jhi
2174 jj=j-my_block%jlo+1
2175 DO i=my_block%ilo,my_block%ihi
2176 ii=i-my_block%ilo+1
2177 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2178 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2179 fval=scale*ptr3d(ii,jj,blk)+add_offset
2180 myfmin(2)=min(myfmin(2),fval)
2181 myfmax(2)=max(myfmax(2),fval)
2182 pair(i,j,blk)=fval
2183 END DO
2184 END DO
2185 END DO
2186 got_pair=.true.
2187!
2188! Air temperature (K) at surface defined by inst_height_lowest (near
2189! surface; maybe lowest level), from ATM.
2190!
2191 CASE ('Tair', 'its', 'inst_temp_height_lowest')
2192 DO blk=1,nblocks
2193 my_block=get_block(blocks_ice(blk), blk)
2194 DO j=my_block%jlo,my_block%jhi
2195 jj=j-my_block%jlo+1
2196 DO i=my_block%ilo,my_block%ihi
2197 ii=i-my_block%ilo+1
2198 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2199 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2200 fval=scale*ptr3d(ii,jj,blk)+add_offset
2201 myfmin(2)=min(myfmin(2),fval)
2202 myfmax(2)=max(myfmax(2),fval)
2203 tair(i,j,blk)=fval
2204 END DO
2205 END DO
2206 END DO
2207 got_tair=.true.
2208!
2209! Air humidity (kg kg-1), at surface defined by inst_height_lowest
2210! (near surface; maybe lowest level), from ATM.
2211!
2212 CASE ('Qair', 'Qa', 'ishh', 'inst_spec_humid_height_lowest')
2213 DO blk=1,nblocks
2214 my_block=get_block(blocks_ice(blk), blk)
2215 DO j=my_block%jlo,my_block%jhi
2216 jj=j-my_block%jlo+1
2217 DO i=my_block%ilo,my_block%ihi
2218 ii=i-my_block%ilo+1
2219 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2220 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2221 fval=scale*ptr3d(ii,jj,blk)+add_offset
2222 myfmin(2)=min(myfmin(2),fval)
2223 myfmax(2)=max(myfmax(2),fval)
2224 qa(i,j,blk)=fval
2225 END DO
2226 END DO
2227 END DO
2228!
2229! Downwelling longwave flux (W m-2), averaged over coupling interval,
2230! from ATM.
2231!
2232 CASE ('flw', 'mdlwfx', 'mean_down_lw_flx')
2233 DO blk=1,nblocks
2234 my_block=get_block(blocks_ice(blk), blk)
2235 DO j=my_block%jlo,my_block%jhi
2236 jj=j-my_block%jlo+1
2237 DO i=my_block%ilo,my_block%ihi
2238 ii=i-my_block%ilo+1
2239 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2240 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2241 fval=scale*ptr3d(ii,jj,blk)+add_offset
2242 myfmin(2)=min(myfmin(2),fval)
2243 myfmax(2)=max(myfmax(2),fval)
2244 flw(i,j,blk)=fval
2245 END DO
2246 END DO
2247 END DO
2248!
2249! Visible direct band of downward shortwave flux (W m-2), averaged
2250! over the coupling interval, from ATM.
2251!
2252 CASE ('swvdr', 'sw_flux_vis_dir', 'mean_down_sw_vis_dir_flx')
2253 DO blk=1,nblocks
2254 my_block=get_block(blocks_ice(blk), blk)
2255 DO j=my_block%jlo,my_block%jhi
2256 jj=j-my_block%jlo+1
2257 DO i=my_block%ilo,my_block%ihi
2258 ii=i-my_block%ilo+1
2259 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2260 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2261 fval=scale*ptr3d(ii,jj,blk)+add_offset
2262 myfmin(2)=min(myfmin(2),fval)
2263 myfmax(2)=max(myfmax(2),fval)
2264 swvdr(i,j,blk)=fval
2265 END DO
2266 END DO
2267 END DO
2268 got_swfx(1)=.true.
2269!
2270! Visible diffusive band of downward shortwave flux (W m-2), averaged
2271! over the coupling interval, from ATM.
2272!
2273 CASE ('swvdf', 'sw_flux_vis_dif', 'mean_down_sw_vis_dif_flx')
2274 DO blk=1,nblocks
2275 my_block=get_block(blocks_ice(blk), blk)
2276 DO j=my_block%jlo,my_block%jhi
2277 jj=j-my_block%jlo+1
2278 DO i=my_block%ilo,my_block%ihi
2279 ii=i-my_block%ilo+1
2280 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2281 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2282 fval=scale*ptr3d(ii,jj,blk)+add_offset
2283 myfmin(2)=min(myfmin(2),fval)
2284 myfmax(2)=max(myfmax(2),fval)
2285 swvdf(i,j,blk)=fval
2286 END DO
2287 END DO
2288 END DO
2289 got_swfx(2)=.true.
2290!
2291! Infrared direct band of downward shortwave flux (W m-2), averaged
2292! over the coupling interval, from ATM.
2293!
2294 CASE ('swidr', 'sw_flux_nir_dir', 'mean_down_sw_ir_dir_flx')
2295 DO blk=1,nblocks
2296 my_block=get_block(blocks_ice(blk), blk)
2297 DO j=my_block%jlo,my_block%jhi
2298 jj=j-my_block%jlo+1
2299 DO i=my_block%ilo,my_block%ihi
2300 ii=i-my_block%ilo+1
2301 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2302 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2303 fval=scale*ptr3d(ii,jj,blk)+add_offset
2304 myfmin(2)=min(myfmin(2),fval)
2305 myfmax(2)=max(myfmax(2),fval)
2306 swidr(i,j,blk)=fval
2307 END DO
2308 END DO
2309 END DO
2310 got_swfx(3)=.true.
2311!
2312! Infrared diffusive band of downward shortwave flux (W m-2), averaged
2313! over the coupling interval, from ATM.
2314!
2315 CASE ('swidf', 'sw_flux_nir_dif', 'mean_down_sw_ir_dif_flx')
2316 DO blk=1,nblocks
2317 my_block=get_block(blocks_ice(blk), blk)
2318 DO j=my_block%jlo,my_block%jhi
2319 jj=j-my_block%jlo+1
2320 DO i=my_block%ilo,my_block%ihi
2321 ii=i-my_block%ilo+1
2322 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2323 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2324 fval=scale*ptr3d(ii,jj,blk)+add_offset
2325 myfmin(2)=min(myfmin(2),fval)
2326 myfmax(2)=max(myfmax(2),fval)
2327 swidf(i,j,blk)=fval
2328 END DO
2329 END DO
2330 END DO
2331 got_swfx(4)=.true.
2332!
2333! Near surface (maybe lowest level) U-wind component (m s-1), from ATM.
2334! Needs to be rotated from east/north to i,j coordinates after it is
2335! loaded.
2336!
2337 CASE ('Uwind', 'uatm', 'inst_zonal_wind_height_lowest')
2338 DO blk=1,nblocks
2339 my_block=get_block(blocks_ice(blk), blk)
2340 DO j=my_block%jlo,my_block%jhi
2341 jj=j-my_block%jlo+1
2342 DO i=my_block%ilo,my_block%ihi
2343 ii=i-my_block%ilo+1
2344 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2345 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2346 fval=scale*ptr3d(ii,jj,blk)+add_offset
2347 myfmin(2)=min(myfmin(2),fval)
2348 myfmax(2)=max(myfmax(2),fval)
2349 uatm(i,j,blk)=fval
2350 END DO
2351 END DO
2352 END DO
2353 got_wind(1)=.true.
2354!
2355! Near surface (maybe lowest level) V-wind component (m s-1), from ATM.
2356! Needs to be rotated from east/north to i,j coordinates after it is
2357! loaded.
2358!
2359 CASE ('Vwind', 'vatm', 'inst_merid_wind_height_lowest')
2360 DO blk=1,nblocks
2361 my_block=get_block(blocks_ice(blk), blk)
2362 DO j=my_block%jlo,my_block%jhi
2363 jj=j-my_block%jlo+1
2364 DO i=my_block%ilo,my_block%ihi
2365 ii=i-my_block%ilo+1
2366 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2367 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2368 fval=scale*ptr3d(ii,jj,blk)+add_offset
2369 myfmin(2)=min(myfmin(2),fval)
2370 myfmax(2)=max(myfmax(2),fval)
2371 vatm(i,j,blk)=fval
2372 END DO
2373 END DO
2374 END DO
2375 got_wind(2)=.true.
2376!
2377! Near surface (maybe lowest level) U-wind stress component (N m-2),
2378! averaged over the coupling interval, from ATM. Needs to be rotated
2379! from east/north to i,j coordinates after it is loaded.
2380!
2381 CASE ('Ustr', 'strax', 'mzmfx', 'mean_zonal_moment_flx')
2382 DO blk=1,nblocks
2383 my_block=get_block(blocks_ice(blk), blk)
2384 DO j=my_block%jlo,my_block%jhi
2385 jj=j-my_block%jlo+1
2386 DO i=my_block%ilo,my_block%ihi
2387 ii=i-my_block%ilo+1
2388 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2389 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2390 fval=scale*ptr3d(ii,jj,blk)+add_offset
2391 myfmin(2)=min(myfmin(2),fval)
2392 myfmax(2)=max(myfmax(2),fval)
2393 strax(i,j,blk)=fval
2394 END DO
2395 END DO
2396 END DO
2397 got_wstr(1)=.true.
2398!
2399! Near surface (maybe lowest level) V-wind stress component (N m-2)),
2400! averaged over the coupling interval, from ATM. Needs to be rotated
2401! from east/north to i,j coordinates after it is loaded.
2402!
2403 CASE ('Vstr', 'stray', 'mmmfx', 'mean_merid_momentum_flx')
2404 DO blk=1,nblocks
2405 my_block=get_block(blocks_ice(blk), blk)
2406 DO j=my_block%jlo,my_block%jhi
2407 jj=j-my_block%jlo+1
2408 DO i=my_block%ilo,my_block%ihi
2409 ii=i-my_block%ilo+1
2410 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2411 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2412 fval=scale*ptr3d(ii,jj,blk)+add_offset
2413 myfmin(2)=min(myfmin(2),fval)
2414 myfmax(2)=max(myfmax(2),fval)
2415 stray(i,j,blk)=fval
2416 END DO
2417 END DO
2418 END DO
2419 got_wstr(2)=.true.
2420!
2421! Liquid precipitation rate (kg m-2 s-1), averaged over the coupling
2422! interval, from ATM.
2423!
2424 CASE ('frain', 'lprec', 'mean_prec_rate')
2425 DO blk=1,nblocks
2426 my_block=get_block(blocks_ice(blk), blk)
2427 DO j=my_block%jlo,my_block%jhi
2428 jj=j-my_block%jlo+1
2429 DO i=my_block%ilo,my_block%ihi
2430 ii=i-my_block%ilo+1
2431 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2432 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2433 fval=scale*ptr3d(ii,jj,blk)+add_offset
2434 myfmin(2)=min(myfmin(2),fval)
2435 myfmax(2)=max(myfmax(2),fval)
2436 frain(i,j,blk)=fval
2437 END DO
2438 END DO
2439 END DO
2440!
2441! Frozen/snow precipitation rate (kg m-2 s-1), averaged over the coupling
2442! interval, from ATM.
2443!
2444 CASE ('fsnow', 'fprec', 'mean_fprec_rate')
2445 DO blk=1,nblocks
2446 my_block=get_block(blocks_ice(blk), blk)
2447 DO j=my_block%jlo,my_block%jhi
2448 jj=j-my_block%jlo+1
2449 DO i=my_block%ilo,my_block%ihi
2450 ii=i-my_block%ilo+1
2451 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2452 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2453 fval=scale*ptr3d(ii,jj,blk)+add_offset
2454 myfmin(2)=min(myfmin(2),fval)
2455 myfmax(2)=max(myfmax(2),fval)
2456 fsnow(i,j,blk)=fval
2457 END DO
2458 END DO
2459 END DO
2460!
2461! Sea surface heigh (m), from OCN.
2462!
2463 CASE ('ssh', 'sea_lev')
2464 DO blk=1,nblocks
2465 my_block=get_block(blocks_ice(blk), blk)
2466 DO j=my_block%jlo,my_block%jhi
2467 jj=j-my_block%jlo+1
2468 DO i=my_block%ilo,my_block%ihi
2469 ii=i-my_block%ilo+1
2470! zonal sea surface slope
2471!
2472 sigma_r=0.5_dp*(ptr3d(ii+1,jj+1,blk)- &
2473 & ptr3d(ii ,jj+1,blk)+ &
2474 & ptr3d(ii+1,jj ,blk)- &
2475 & ptr3d(ii ,jj ,blk))/dxt(i,j,blk)
2476 sigma_l=0.5_dp*(ptr3d(ii ,jj+1,blk)- &
2477 & ptr3d(ii-1,jj+1,blk)+ &
2478 & ptr3d(ii ,jj ,blk)- &
2479 & ptr3d(ii-1,jj ,blk))/dxt(i,j,blk)
2480 sigma_c=0.5_dp*(sigma_r+sigma_l)
2481 IF ((sigma_r*sigma_l).gt.0.0_dp) THEN
2482 slopex=sign(min(2.0_dp*min(abs(sigma_l), &
2483 & abs(sigma_r)), &
2484 & abs(sigma_c)), &
2485 & sigma_c)
2486 ELSE
2487 slopex=0.0_dp
2488 ENDIF
2489! meridional sea surface slope
2490!
2491 sigma_r=0.5_dp*(ptr3d(ii+1,jj+1,blk)- &
2492 & ptr3d(ii+1,jj ,blk)+ &
2493 & ptr3d(ii ,jj+1,blk)- &
2494 & ptr3d(ii ,jj ,blk))/dyt(i,j,blk)
2495 sigma_l=0.5_dp*(ptr3d(ii+1,jj ,blk)- &
2496 & ptr3d(ii+1,jj-1,blk)+ &
2497 & ptr3d(ii ,jj ,blk)- &
2498 & ptr3d(ii ,jj-1,blk))/dyt(i,j,blk)
2499 sigma_c=0.5_dp*(sigma_r+sigma_l)
2500 IF ((sigma_r*sigma_l).gt.0.0_dp) THEN
2501 slopey=sign(min(2.0_dp*min(abs(sigma_l), &
2502 & abs(sigma_r)), &
2503 & abs(sigma_c)), &
2504 & sigma_c)
2505 ELSE
2506 slopey(i,j,blk)=0.0_dp
2507 ENDIF
2508! rotate onto local basis vectors
2509!
2510 ss_tltx(i,j,blk)= slopex*cos(anglet(i,j,blk))+ &
2511 & slopey*sin(anglet(i,j,blk))
2512 ss_tlty(i,j,blk)=-slopex*sin(anglet(i,j,blk))+ &
2513 & slopey*cos(anglet(i,j,blk))
2514!
2515 CALL t2ugrid_vector (ss_tltx)
2516 CALL t2ugrid_vector (ss_tlty)
2517 END DO
2518 END DO
2519 END DO
2520!
2521! Ocean mixed layer depth (m), from OCN.
2522!
2523 CASE ('hmix', 'mixed_layer_depth')
2524 DO blk=1,nblocks
2525 my_block=get_block(blocks_ice(blk), blk)
2526 DO j=my_block%jlo,my_block%jhi
2527 jj=j-my_block%jlo+1
2528 DO i=my_block%ilo,my_block%ihi
2529 ii=i-my_block%ilo+1
2530 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2531 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2532 fval=scale*ptr3d(ii,jj,blk)+add_offset
2533 myfmin(2)=min(myfmin(2),fval)
2534 myfmax(2)=max(myfmax(2),fval)
2535 hmix(i,j,blk)=fval
2536 END DO
2537 END DO
2538 END DO
2539!
2540! Freezing/Melting potential (W m-2), from OCN.
2541!
2542 CASE ('frzmlt', 'freezing_melting_potential')
2543 DO blk=1,nblocks
2544 my_block=get_block(blocks_ice(blk), blk)
2545 DO j=my_block%jlo,my_block%jhi
2546 jj=j-my_block%jlo+1
2547 DO i=my_block%ilo,my_block%ihi
2548 ii=i-my_block%ilo+1
2549 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2550 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2551 fval=scale*ptr3d(ii,jj,blk)+add_offset
2552 myfmin(2)=min(myfmin(2),fval)
2553 myfmax(2)=max(myfmax(2),fval)
2554 frzmlt(i,j,blk)=fval
2555 END DO
2556 END DO
2557 END DO
2558!
2559! Sea surface temperature (Celsius), maybe not needed, from OCN.
2560!
2561 CASE ('sst', 'sea_surface_temperature')
2562 DO blk=1,nblocks
2563 my_block=get_block(blocks_ice(blk), blk)
2564 DO j=my_block%jlo,my_block%jhi
2565 jj=j-my_block%jlo+1
2566 DO i=my_block%ilo,my_block%ihi
2567 ii=i-my_block%ilo+1
2568 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2569 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2570 fval=scale*ptr3d(ii,jj,blk)+add_offset
2571 myfmin(2)=min(myfmin(2),fval)
2572 myfmax(2)=max(myfmax(2),fval)
2573 sst(i,j,blk)=fval
2574 END DO
2575 END DO
2576 END DO
2577!
2578! Sea surface salinity (maybe for mushy layer), from OCN.
2579!
2580 CASE ('sss', 's_surf', 's_surf_ppt')
2581 DO blk=1,nblocks
2582 my_block=get_block(blocks_ice(blk), blk)
2583 DO j=my_block%jlo,my_block%jhi
2584 jj=j-my_block%jlo+1
2585 DO i=my_block%ilo,my_block%ihi
2586 ii=i-my_block%ilo+1
2587 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2588 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2589 fval=scale*ptr3d(ii,jj,blk)+add_offset
2590 myfmin(2)=min(myfmin(2),fval)
2591 myfmax(2)=max(myfmax(2),fval)
2592 sss(i,j,blk)=fval
2593 END DO
2594 END DO
2595 END DO
2596!
2597! Zonal surface ocean current (m s-1), from OCN. Needs to be
2598! rotated from east/north to i,j after it is loaded.
2599!
2600 CASE ('Usur', 'uocn', 'ocn_current_zonal')
2601 DO blk=1,nblocks
2602 my_block=get_block(blocks_ice(blk), blk)
2603 DO j=my_block%jlo,my_block%jhi
2604 jj=j-my_block%jlo+1
2605 DO i=my_block%ilo,my_block%ihi
2606 ii=i-my_block%ilo+1
2607 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2608 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2609 fval=scale*ptr3d(ii,jj,blk)+add_offset
2610 myfmin(2)=min(myfmin(2),fval)
2611 myfmax(2)=max(myfmax(2),fval)
2612 uocn(i,j,blk)=fval
2613 END DO
2614 END DO
2615 END DO
2616 got_current(1)=.true.
2617!
2618! Meridional surface ocean current (m s-1), from OCN. Needs to be
2619! rotated from east/north to i,j after it is loaded.
2620!
2621 CASE ('Vsur', 'vocn', 'ocn_current_merid')
2622 DO blk=1,nblocks
2623 my_block=get_block(blocks_ice(blk), blk)
2624 DO j=my_block%jlo,my_block%jhi
2625 jj=j-my_block%jlo+1
2626 DO i=my_block%ilo,my_block%ihi
2627 ii=i-my_block%ilo+1
2628 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2629 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2630 fval=scale*ptr3d(ii,jj,blk)+add_offset
2631 myfmin(2)=min(myfmin(2),fval)
2632 myfmax(2)=max(myfmax(2),fval)
2633 uocn(i,j,blk)=fval
2634 END DO
2635 END DO
2636 END DO
2637 got_current(2)=.true.
2638!
2639! Import field not found.
2640!
2641 CASE DEFAULT
2642 IF (localpet.eq.0) THEN
2643 WRITE (cplout,10) trim(importnamelist(ifld)), &
2644 & trim(time_currentstring), &
2645 & trim(cinpname)
2646 END IF
2647 IF (founderror(exit_flag, noerror, __line__, &
2648 & myfile)) THEN
2649 rc=esmf_rc_not_found
2650 RETURN
2651 END IF
2652 END SELECT
2653!
2654! Print pointer information.
2655!
2656 IF (debuglevel.eq.4) THEN
2657 WRITE (cplout,20) localpet &
2658 & lbound(ptr3d, dim=1), ubound(ptr3d, dim=1), &
2659 & lbound(ptr3d, dim=2), ubound(ptr3d, dim=2), &
2660 & lbound(ptr3d, dim=3), ubound(ptr3d, dim=3)
2661 END IF
2662!
2663! Nullify pointer to make sure that it does not point on a random
2664! part in the memory.
2665!
2666 IF (associated(ptr3d)) nullify (ptr3d)
2667!
2668! Get import field minimun and maximum values.
2669!
2670 CALL esmf_vmallreduce (vm, &
2671 & senddata=myfmin, &
2672 & recvdata=fmin, &
2673 & count=2, &
2674 & reduceflag=esmf_reduce_min, &
2675 & rc=rc)
2676 IF (esmf_logfounderror(rctocheck=rc, &
2677 & msg=esmf_logerr_passthru, &
2678 & line=__line__, &
2679 & file=myfile)) THEN
2680 RETURN
2681 END IF
2682!
2683 CALL esmf_vmallreduce (vm, &
2684 & senddata=myfmax, &
2685 & recvdata=fmax, &
2686 & count=2, &
2687 & reduceflag=esmf_reduce_max, &
2688 & rc=rc)
2689 IF (esmf_logfounderror(rctocheck=rc, &
2690 & msg=esmf_logerr_passthru, &
2691 & line=__line__, &
2692 & file=myfile)) THEN
2693 RETURN
2694 END IF
2695!
2696! Write out import field information.
2697!
2698 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
2699 WRITE (cplout,30) trim(importnamelist(ifld)), &
2700 & trim(time_currentstring), ng, &
2701 & fmin(1), fmax(1)
2702 IF (cicescale.ne.1.0_dp) THEN
2703 WRITE (cplout,40) fmin(2), fmax(2), &
2704 & ' ciceScale = ', cicescale
2705 ELSE IF (add_offset.ne.0.0_dp) THEN
2706 WRITE (cplout,40) fmin(2), fmax(2), &
2707 & ' AddOffset = ', add_offset
2708 END IF
2709 END IF
2710!
2711! Debugging: write out import field into NetCDF file.
2712!
2713 IF ((debuglevel.ge.3).and. &
2714 & models(iseaice)%ImportField(id)%debug_write) THEN
2715 WRITE (ofile,50) ng, trim(importnamelist(ifld)), &
2716 & year, month, day, hour, minutes, seconds
2717 CALL esmf_fieldwrite (field, &
2718 & trim(ofile), &
2719 & overwrite=.true., &
2720 & rc=rc)
2721 IF (esmf_logfounderror(rctocheck=rc, &
2722 & msg=esmf_logerr_passthru, &
2723 & line=__line__, &
2724 & file=myfile)) THEN
2725 RETURN
2726 END IF
2727 END IF
2728
2729 END DO fld_loop
2730!
2731! Deallocate local arrays.
2732!
2733 IF (allocated(importnamelist)) deallocate (importnamelist)
2734!
2735! Update ROMS import calls counter.
2736!
2737 IF (importcount.gt.0) THEN
2738 models(iseaice)%ImportCalls=models(iseaice)%ImportCalls+1
2739 END IF
2740!
2741! Rotate wind components from east/north to i,j coordinates and compute
2742! wind magnitude.
2743!
2744 IF (all(got_wind)) THEN
2745 DO blk=1,nblocks
2746 my_block=get_block(blocks_ice(blk), blk)
2747 DO j=my_block%jlo,my_block%jhi
2748 DO i=my_block%ilo,my_block%ihi
2749 uvel=uatm(i,j,blk)
2750 vvel=vatm(i,j,blk)
2751 uatm(i,j,blk)= uvel*cos(anglet(i,j,blk))+ &
2752 & vvel*sin(anglet(i,j,blk))
2753 vatm(i,j,blk)=-uvel*sin(anglet(i,j,blk))+ &
2754 & vvel*cos(anglet(i,j,blk))
2755 wind(i,j,blk)=sqrt(uvel*uvel+vvel*vvel)
2756 END DO
2757 END DO
2758 END DO
2759 END IF
2760!
2761! Rotate wind stress components from east/north to i,j coordinates.
2762!
2763 IF (all(got_wind)) THEN
2764 DO blk=1,nblocks
2765 my_block=get_block(blocks_ice(blk), blk)
2766 DO j=my_block%jlo,my_block%jhi
2767 DO i=my_block%ilo,my_block%ihi
2768 uvel=strax(i,j,blk)
2769 vvel=stray(i,j,blk)
2770 strax(i,j,blk)= uvel*cos(anglet(i,j,blk))+ &
2771 & vvel*sin(anglet(i,j,blk))
2772 stray(i,j,blk)=-uvel*sin(anglet(i,j,blk))+ &
2773 & vvel*cos(anglet(i,j,blk))
2774 END DO
2775 END DO
2776 END DO
2777 END IF
2778!
2779! Rotate ocean current components from east/north to i,j coordinates.
2780!
2781 IF (all(got_current)) THEN
2782 DO blk=1,nblocks
2783 my_block=get_block(blocks_ice(blk), blk)
2784 DO j=my_block%jlo,my_block%jhi
2785 DO i=my_block%ilo,my_block%ihi
2786 uvel=uocn(i,j,blk)
2787 vvel=vocn(i,j,blk)
2788 uocn(i,j,blk)= uvel*cos(anglet(i,j,blk))+ &
2789 & vvel*sin(anglet(i,j,blk))
2790 vocn(i,j,blk)=-uvel*sin(anglet(i,j,blk))+ &
2791 & vvel*cos(anglet(i,j,blk))
2792 END DO
2793 END DO
2794 END DO
2795 END IF
2796!
2797! Compute potential air temperature (K).
2798!
2799 IF (got_pair.and.got_tair) THEN
2800 DO blk=1,nblocks
2801 my_block=get_block(blocks_ice(blk), blk)
2802 DO j=my_block%jlo,my_block%jhi
2803 DO i=my_block%ilo,my_block%ihi
2804 pott(i,j,blk)=tair(i,j,blk)* &
2805 & (100000.0_dp/pair(i,j,blk))**0.286_dp
2806 END DO
2807 END DO
2808 END DO
2809 END IF
2810!
2811! Compute net incomming shortwave radiation (W m-2).
2812
2813 IF (all(got_swfx)) THEN
2814 DO blk=1,nblocks
2815 my_block=get_block(blocks_ice(blk), blk)
2816 DO j=my_block%jlo,my_block%jhi
2817 DO i=my_block%ilo,my_block%ihi
2818 fsw(i,j,blk)=swvdr(i,j,blk)+ &
2819 & swvdf(i,j,blk)+ &
2820 & swidr(i,j,blk)+ &
2821 & swidf(i,j,blk)
2822 END DO
2823 END DO
2824 END DO
2825 END IF
2826!
2827! Deallocate arrays.
2828!
2829 IF (allocated(importnamelist)) deallocate (importnamelist)
2830!
2831 IF (esm_track) THEN
2832 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_Import', &
2833 & ', PET', petrank
2834 FLUSH (trac)
2835 END IF
2836 IF (debuglevel.gt.0) FLUSH (cplout)
2837!
2838 10 FORMAT (/,3x,' CICE_Import - unable to find option to import: ', &
2839 & a,t68,a,/,18x,'check ''Import(roms)'' in input script: ', &
2840 & a)
2841 20 FORMAT (18x,'PET [',i3.3,'], Pointer Size: ',6i8)
2842 30 FORMAT (3x,' CICE_Import - ESMF: importing field ''',a,'''', &
2843 & t72,a,2x,'Grid ',i2.2, &
2844 & /,19x,'(Dmin = ', 1p,e15.8,0p,' Dmax = ',1p,e15.8,0p,')')
2845 40 FORMAT (19x,'(Cmin = ', 1p,e15.8,0p,' Cmax = ',1p,e15.8,0p, &
2846 & a,1p,e15.8,0p,')')
2847 50 FORMAT ('cice_',i2.2,'_import_',a,'_',i4.4,2('-',i2.2),'_', &
2848 & i2.2,2('.',i2.2),'.nc')
2849
2850 RETURN

References mod_esmf_esm::cinpname, mod_esmf_esm::cplout, mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, mod_esmf_esm::field_index(), mod_esmf_esm::iseaice, mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by cice_modeladvance().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ cice_modeladvance()

subroutine, private esmf_roms_mod::cice_modeladvance ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1668 of file esmf_ice_cice.h.

1669!
1670!=======================================================================
1671! !
1672! Advance CICE component for a coupling interval (seconds) using !
1673! "CICE_run". It also calls "CICE_Import" and "CICE_Export" to import !
1674! and export coupling fields, respectively. !
1675! !
1676!=======================================================================
1677!
1678!! USE mod_runparams, ONLY : ifrest, ktau, dtsrf
1679!
1680! Imported variable declarations.
1681!
1682 integer, intent(out) :: rc
1683!
1684 TYPE (ESMF_GridComp) :: model
1685!
1686! Local variable declarations.
1687!
1688 logical :: Ladvance
1689 integer :: is, ng
1690 integer :: localPET, phase
1691!
1692 real (dp) :: CouplingInterval, RunInterval
1693 real (dp) :: TcurrentInSeconds, TstopInSeconds
1694!
1695 character (len=22) :: Cinterval
1696 character (len=22) :: CurrTimeString, StopTimeString
1697
1698 character (len=*), parameter :: MyFile = &
1699 & __FILE__//", CICE_ModelAdvance"
1700!
1701 TYPE (ESMF_Clock) :: clock
1702 TYPE (ESMF_State) :: ExportState, ImportState
1703 TYPE (ESMF_Time) :: ReferenceTime
1704 TYPE (ESMF_Time) :: CurrentTime, StopTime
1705 TYPE (ESMF_TimeInterval) :: TimeStep
1706 TYPE (ESMF_VM) :: vm
1707!
1708!-----------------------------------------------------------------------
1709! Initialize return code flag to success state (no error).
1710!-----------------------------------------------------------------------
1711!
1712 IF (esm_track) THEN
1713 WRITE (trac,'(a,a,i0)') '==> Entering CICE_ModelAdvance', &
1714 & ', PET', petrank
1715 FLUSH (trac)
1716 END IF
1717 rc=esmf_success
1718!
1719!-----------------------------------------------------------------------
1720! Get information about the gridded component.
1721!-----------------------------------------------------------------------
1722!
1723! Inquire about CICE component.
1724!
1725 CALL esmf_gridcompget (model, &
1726 & importstate=importstate, &
1727 & exportstate=exportstate, &
1728 & clock=clock, &
1729 & localpet=localpet, &
1730 & currentphase=phase, &
1731 & vm=vm, &
1732 & rc=rc)
1733 IF (esmf_logfounderror(rctocheck=rc, &
1734 & msg=esmf_logerr_passthru, &
1735 & line=__line__, &
1736 & file=myfile)) THEN
1737 RETURN
1738 END IF
1739!
1740! Get time step interval, stopping time, reference time, and current
1741! time.
1742!
1743 CALL esmf_clockget (clock, &
1744 & timestep=timestep, &
1745 & stoptime=stoptime, &
1746 & reftime=referencetime, &
1747 & currtime=clockinfo(iseaice)%CurrentTime, &
1748 & rc=rc)
1749 IF (esmf_logfounderror(rctocheck=rc, &
1750 & msg=esmf_logerr_passthru, &
1751 & line=__line__, &
1752 & file=myfile)) THEN
1753 RETURN
1754 END IF
1755!
1756! Current CICE time (seconds).
1757!
1758 CALL esmf_timeget (clockinfo(iseaice)%CurrentTime, &
1759 & s_r8=tcurrentinseconds, &
1760 & timestringisofrac=currtimestring, &
1761 & rc=rc)
1762 IF (esmf_logfounderror(rctocheck=rc, &
1763 & msg=esmf_logerr_passthru, &
1764 & line=__line__, &
1765 & file=myfile)) THEN
1766 RETURN
1767 END IF
1768 is=index(currtimestring, 'T') ! remove 'T' in
1769 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
1770!
1771! CICE stop time (seconds) for this coupling window.
1772!
1773 CALL esmf_timeget (clockinfo(iseaice)%CurrentTime+timestep, &
1774 & s_r8=tstopinseconds, &
1775 & timestringisofrac=stoptimestring, &
1776 & rc=rc)
1777 IF (esmf_logfounderror(rctocheck=rc, &
1778 & msg=esmf_logerr_passthru, &
1779 & line=__line__, &
1780 & file=myfile)) THEN
1781 RETURN
1782 END IF
1783 is=index(stoptimestring, 'T') ! remove 'T' in
1784 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
1785!
1786! Get coupling time interval (seconds, double precision).
1787!
1788 CALL esmf_timeintervalget (timestep, &
1789 & s_r8=couplinginterval, &
1790 & rc=rc)
1791 IF (esmf_logfounderror(rctocheck=rc, &
1792 & msg=esmf_logerr_passthru, &
1793 & line=__line__, &
1794 & file=myfile)) THEN
1795 RETURN
1796 END IF
1797!
1798! Set CICE running interval (seconds) for the current coupling window.
1799!
1800 ladvance=.true.
1801 runinterval=couplinginterval
1802!
1803!-----------------------------------------------------------------------
1804! Report time information strings (YYYY-MM-DD hh:mm:ss).
1805!-----------------------------------------------------------------------
1806!
1807 IF (localpet.eq.0) THEN
1808 WRITE (cinterval,'(f15.2)') couplinginterval
1809 WRITE (cplout,10) trim(currtimestring), trim(stoptimestring), &
1810 & phase, trim(adjustl(cinterval))
1811 END IF
1812!
1813!-----------------------------------------------------------------------
1814! Get import fields from other ESM components.
1815!-----------------------------------------------------------------------
1816!
1817 IF ((nimport(iseaice).gt.0).and. &
1818 & (tcurrentinseconds.gt.clockinfo(idriver)%Time_Start)) THEN
1819 DO ng=1,models(iseaice)%Ngrids
1820 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
1821 CALL cice_import (ng, model, rc)
1822 IF (esmf_logfounderror(rctocheck=rc, &
1823 & msg=esmf_logerr_passthru, &
1824 & line=__line__, &
1825 & file=myfile)) THEN
1826 RETURN
1827 END IF
1828 END IF
1829 END DO
1830 ELSE
1831 ladvance=.false.
1832 END IF
1833!
1834!-----------------------------------------------------------------------
1835! Run CICE component.
1836!-----------------------------------------------------------------------
1837!
1838 IF (ladvance)) THEN
1839 CALL cice_run
1840 END IF
1841!
1842!-----------------------------------------------------------------------
1843! Put export fields.
1844!-----------------------------------------------------------------------
1845!
1846 IF (nexport(iseaice).gt.0) THEN
1847 DO ng=1,models(iseaice)%Ngrids
1848 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
1849 CALL cice_export (ng, model, rc)
1850 IF (esmf_logfounderror(rctocheck=rc, &
1851 & msg=esmf_logerr_passthru, &
1852 & line=__line__, &
1853 & file=myfile)) THEN
1854 RETURN
1855 END IF
1856 END IF
1857 END DO
1858 END IF
1859!
1860 IF (esm_track) THEN
1861 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_ModelAdvance', &
1862 & ', PET', petrank
1863 FLUSH (trac)
1864 END IF
1865!
1866 10 FORMAT (3x,'ModelAdvance - ESMF, Running CICE:',t42,a, &
1867 & ' => ',a,', Phase: ',i1,' [',a,' s]')
1868!
1869 RETURN

References cice_export(), cice_import(), mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_esmf_esm::esm_track, mod_esmf_esm::idriver, mod_esmf_esm::iseaice, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::nimport, mod_esmf_esm::petrank, mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by ice_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ cice_setclock()

subroutine, private esmf_roms_mod::cice_setclock ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 581 of file esmf_ice_cice.h.

582!
583!=======================================================================
584! !
585! Sets CICE component date calendar, start and stop time, and !
586! coupling interval. !
587! !
588!=======================================================================
589!
590!! USE coamnl_mod, ONLY : ktaust ! starting time (hour, min, sec)
591!! USE coamnl_mod, ONLY : ktauf ! ending time (hour, min, sec)
592!
593! Imported variable declarations.
594!
595 integer, intent(out) :: rc
596!
597 TYPE (ESMF_GridComp) :: model
598!
599! Local variable declarations.
600!
601 integer :: PETcount, localPET
602 integer :: TimeFrac, ig
603# ifdef REGRESS_STARTCLOCK
604 integer :: RegressStartDate(7)
605# endif
606!
607# ifdef REGRESS_STARTCLOCK
608 character (len= 20) :: RegressStartString
609# endif
610 character (len= 20) :: Calendar
611 character (len=160) :: message
612
613 character (len=*), parameter :: MyFile = &
614 & __FILE__//", CICE_SetClock"
615!
616 TYPE (ESMF_CalKind_Flag) :: CalType
617 TYPE (ESMF_Time) :: StartTime
618 TYPE (ESMF_VM) :: vm
619!
620!-----------------------------------------------------------------------
621! Initialize return code flag to success state (no error).
622!-----------------------------------------------------------------------
623!
624 IF (esm_track) THEN
625 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetClock', &
626 & ', PET', petrank
627 FLUSH (trac)
628 END IF
629 rc=esmf_success
630!
631!-----------------------------------------------------------------------
632! Querry the Virtual Machine (VM) parallel environmemt for the MPI
633! communicator handle and current node rank.
634!-----------------------------------------------------------------------
635!
636 CALL esmf_gridcompget (model, &
637 & localpet=localpet, &
638 & petcount=petcount, &
639 & vm=vm, &
640 & rc=rc)
641 IF (esmf_logfounderror(rctocheck=rc, &
642 & msg=esmf_logerr_passthru, &
643 & line=__line__, &
644 & file=myfile)) THEN
645 RETURN
646 END IF
647!
648!-----------------------------------------------------------------------
649! Create CICE component clock.
650!-----------------------------------------------------------------------
651!
652 calendar=trim(clockinfo(iseaice)%CalendarString)
653 IF (trim(calendar).eq.'gregorian') THEN
654 caltype=esmf_calkind_gregorian
655 ELSE
656 caltype=esmf_calkind_gregorian
657 END IF
658!
659 clockinfo(iseaice)%Calendar=esmf_calendarcreate(caltype, &
660 & name=trim(calendar), &
661 & rc=rc)
662 IF (esmf_logfounderror(rctocheck=rc, &
663 & msg=esmf_logerr_passthru, &
664 & line=__line__, &
665 & file=myfile)) THEN
666 RETURN
667 END IF
668!
669! Set reference time. Use driver configuration values.
670!
671 CALL esmf_timeset (clockinfo(iseaice)%ReferenceTime, &
672 & yy=referencedate(1), &
673 & mm=referencedate(2), &
674 & dd=referencedate(3), &
675 & h =referencedate(4), &
676 & m =referencedate(5), &
677 & s =referencedate(6), &
678 & calendar=clockinfo(iseaice)%Calendar, &
679 & rc=rc)
680 IF (esmf_logfounderror(rctocheck=rc, &
681 & msg=esmf_logerr_passthru, &
682 & line=__line__, &
683 & file=myfile)) THEN
684 RETURN
685 END IF
686
687# ifdef REGRESS_STARTCLOCK
688!
689! Use the same as driver. A coupling interval is substracted to the
690! driver clock to properly initialize all the ESM components.
691!
692 clockinfo(iseaice)%StartTime=clockinfo(idriver)%StartTime
693!
694 CALL esmf_timeget (clockinfo(iseaice)%StartTime, &
695 & yy=regressstartdate(1), &
696 & mm=regressstartdate(2), &
697 & dd=regressstartdate(3), &
698 & h= regressstartdate(4), &
699 & m= regressstartdate(5), &
700 & s= regressstartdate(6), &
701 & ms=regressstartdate(7), &
702 & timestring=regressstartstring, &
703 & rc=rc)
704 IF (esmf_logfounderror(rctocheck=rc, &
705 & msg=esmf_logerr_passthru, &
706 & line=__line__, &
707 & file=myfile)) THEN
708 RETURN
709 END IF
710# else
711!
712! Set start time. Use driver configuration values.
713!
714 CALL esmf_timeset (clockinfo(iseaice)%StartTime, &
715 yy=startdate(1), &
716 mm=startdate(2), &
717 dd=startdate(3), &
718 h =startdate(4), &
719 m =startdate(5), &
720 s =startdate(6), &
721 calendar=clockinfo(iseaice)%Calendar, &
722 rc=rc)
723 IF (esmf_logfounderror(rctocheck=rc, &
724 & msg=esmf_logerr_passthru, &
725 & line=__line__, &
726 & file=myfile)) THEN
727 RETURN
728 END IF
729# endif
730!
731! Set stop time. Use driver configuration values.
732!
733 CALL esmf_timeset (clockinfo(iseaice)%StopTime, &
734 & yy=stopdate(1), &
735 & mm=stopdate(2), &
736 & dd=stopdate(3), &
737 & h =stopdate(4), &
738 & m =stopdate(5), &
739 & s =stopdate(6), &
740 & calendar=clockinfo(iseaice)%Calendar, &
741 & rc=rc)
742 IF (esmf_logfounderror(rctocheck=rc, &
743 & msg=esmf_logerr_passthru, &
744 & line=__line__, &
745 & file=myfile)) THEN
746 RETURN
747 END IF
748!
749!-----------------------------------------------------------------------
750! Get component clock.
751!-----------------------------------------------------------------------
752!
753 CALL esmf_gridcompget (model, &
754 & clock=clockinfo(iseaice)%Clock, &
755 & rc=rc)
756 IF (esmf_logfounderror(rctocheck=rc, &
757 & msg=esmf_logerr_passthru, &
758 & line=__line__, &
759 & file=myfile)) THEN
760 RETURN
761 END IF
762!
763 CALL esmf_clockget (clockinfo(iseaice)%Clock, &
764 & timestep=clockinfo(iseaice)%TimeStep, &
765 & currtime=clockinfo(iseaice)%CurrentTime, &
766 & rc=rc)
767 IF (esmf_logfounderror(rctocheck=rc, &
768 & msg=esmf_logerr_passthru, &
769 & line=__line__, &
770 & file=myfile)) THEN
771 RETURN
772 END IF
773!
774!-----------------------------------------------------------------------
775! Compare driver time against CICE component time.
776!-----------------------------------------------------------------------
777!
778 IF (clockinfo(idriver)%Restarted) THEN
779 starttime=clockinfo(idriver)%RestartTime
780 ELSE
781 starttime=clockinfo(idriver)%StartTime
782 END IF
783!
784 IF (clockinfo(iseaice)%StartTime.ne.starttime) THEN
785 CALL esmf_timeprint (clockinfo(iseaice)%StartTime, &
786 & options="string", &
787 & rc=rc)
788 IF (esmf_logfounderror(rctocheck=rc, &
789 & msg=esmf_logerr_passthru, &
790 & line=__line__, &
791 & file=myfile)) THEN
792 RETURN
793 END IF
794!
795 CALL esmf_timeprint (starttime, &
796 & options="string", &
797 & rc=rc)
798 IF (esmf_logfounderror(rctocheck=rc, &
799 & msg=esmf_logerr_passthru, &
800 & line=__line__, &
801 & file=myfile)) THEN
802 RETURN
803 END IF
804!
805 message='Driver and CICE start times do not match: '// &
806 & 'please check the config files.'
807 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
808 & msg=trim(message))
809 RETURN
810 END IF
811!
812 IF (clockinfo(iseaice)%StopTime.ne. &
813 & clockinfo(idriver)%StopTime) THEN
814 CALL esmf_timeprint (clockinfo(iseaice)%StopTime, &
815 & options="string", &
816 & rc=rc)
817 IF (esmf_logfounderror(rctocheck=rc, &
818 & msg=esmf_logerr_passthru, &
819 & line=__line__, &
820 & file=myfile)) THEN
821 RETURN
822 END IF
823!
824 CALL esmf_timeprint (clockinfo(idriver)%StopTime, &
825 & options="string", &
826 & rc=rc)
827 IF (esmf_logfounderror(rctocheck=rc, &
828 & msg=esmf_logerr_passthru, &
829 & line=__line__, &
830 & file=myfile)) THEN
831 RETURN
832 END IF
833!
834 message='Driver and CICE stop times do not match: '// &
835 & 'please check the config files.'
836 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
837 & msg=trim(message))
838 RETURN
839 END IF
840!
841 IF (clockinfo(iseaice)%Calendar.ne. &
842 & clockinfo(idriver)%Calendar) THEN
843 CALL esmf_calendarprint (clockinfo(iseaice)%Calendar, &
844 & options="calkindflag", &
845 & rc=rc)
846 IF (esmf_logfounderror(rctocheck=rc, &
847 & msg=esmf_logerr_passthru, &
848 & line=__line__, &
849 & file=myfile)) THEN
850 RETURN
851 END IF
852!
853 CALL esmf_calendarprint (clockinfo(idriver)%Calendar, &
854 & options="calkindflag", &
855 & rc=rc)
856 IF (esmf_logfounderror(rctocheck=rc, &
857 & msg=esmf_logerr_passthru, &
858 & line=__line__, &
859 & file=myfile)) THEN
860 RETURN
861 END IF
862!
863 message='Driver and CICE calendars do not match: '// &
864 & 'please check the config files.'
865 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
866 & msg=trim(message))
867 RETURN
868 END IF
869!
870!-----------------------------------------------------------------------
871! Modify component clock time step.
872!-----------------------------------------------------------------------
873!
874 timefrac=0
875 DO ig=1,models(iseaice)%Ngrids
876 timefrac=max(timefrac, &
877 & maxval(models(iseaice)%TimeFrac(ig,:), &
878 & mask=models(:)%IsActive))
879 END DO
880 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
881 rc=esmf_rc_not_set ! cannot be 0
882 IF (esmf_logfounderror(rctocheck=rc, &
883 & msg=esmf_logerr_passthru, &
884 & line=__line__, &
885 & file=myfile)) THEN
886 RETURN
887 END IF
888 END IF
889 clockinfo(iseaice)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
890!
891 clockinfo(iseaice)%Name='CICE_clock'
892 CALL esmf_clockset (clockinfo(iseaice)%Clock, &
893 & name=trim(clockinfo(iseaice)%Name), &
894 & reftime =clockinfo(iseaice)%ReferenceTime, &
895 & timestep =clockinfo(iseaice)%TimeStep, &
896 & starttime=clockinfo(iseaice)%StartTime, &
897 & stoptime =clockinfo(iseaice)%StopTime, &
898 rc=rc)
899 IF (esmf_logfounderror(rctocheck=rc, &
900 & msg=esmf_logerr_passthru, &
901 & line=__line__, &
902 & file=myfile)) THEN
903 RETURN
904 END IF
905!
906 IF (esm_track) THEN
907 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetClock', &
908 & ', PET', petrank
909 FLUSH (trac)
910 END IF
911!
912 RETURN

References mod_esmf_esm::clockinfo, mod_esmf_esm::esm_track, mod_esmf_esm::idriver, mod_esmf_esm::iseaice, mod_esmf_esm::models, mod_esmf_esm::petrank, mod_esmf_esm::referencedate, mod_esmf_esm::startdate, mod_esmf_esm::stopdate, mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by ice_setservices().

Here is the caller graph for this function:

◆ cice_setfinalize()

subroutine, private esmf_roms_mod::cice_setfinalize ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 1872 of file esmf_ice_cice.h.

1875!
1876!=======================================================================
1877! !
1878! Finalize CICE component execution. It calls CICE_finalize. !
1879! !
1880!=======================================================================
1881!
1882! Imported variable declarations.
1883!
1884 integer, intent(out) :: rc
1885!
1886 TYPE (ESMF_Clock) :: clock
1887 TYPE (ESMF_GridComp) :: model
1888 TYPE (ESMF_State) :: ExportState
1889 TYPE (ESMF_State) :: ImportState
1890!
1891! Local variable declarations.
1892!
1893 character (len=*), parameter :: MyFile = &
1894 & __FILE__//", CICE_SetFinalize"
1895!
1896!-----------------------------------------------------------------------
1897! Initialize return code flag to success state (no error).
1898!-----------------------------------------------------------------------
1899!
1900 IF (esm_track) THEN
1901 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetFinalize', &
1902 & ', PET', petrank
1903 FLUSH (trac)
1904 END IF
1905 rc=esmf_success
1906!
1907!-----------------------------------------------------------------------
1908! Finalize CICE component.
1909!-----------------------------------------------------------------------
1910!
1911 CALL cice_finalize
1912 FLUSH (6) ! flush standard output buffer
1913!
1914 IF (esm_track) THEN
1915 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetFinalize', &
1916 & ', PET', petrank
1917 FLUSH (trac)
1918 END IF
1919!
1920 RETURN

References mod_esmf_esm::esm_track, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by ice_setservices().

Here is the caller graph for this function:

◆ cice_setgridarrays()

subroutine, private esmf_roms_mod::cice_setgridarrays ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 915 of file esmf_ice_cice.h.

916!
917!=======================================================================
918! !
919! Sets CICE component staggered, horizontal grids arrays, grid area, !
920! and land/sea mask. !
921! !
922!=======================================================================
923!
924 USE ice_blocks, ONLY : nblocks_tot
925 USE ice_blocks, ONLY : block
926 USE ice_blocks, ONLY : get_block, get_block_parameter
927 USE ice_constants, ONLY : rad_to_deg
928 USE ice_distribution, ONLY : ice_distributiongetblockloc
929 USE ice_domain, ONLY : nblocks, blocks_ice, distrb_info
930 USE ice_domain_size, ONLY : nx_global, ny_global
931 USE ice_grid, ONLY : tlat, tlon, ulat, ulon, tarea, &
932 & hm, uvm
933!
934! Imported variable declarations.
935!
936 integer, intent(in) :: ng
937 integer, intent(out) :: rc
938!
939 TYPE (ESMF_GridComp) :: model
940!
941! Local variable declarations.
942!
943 integer :: blk, i, ii, ilo, ihi, j, jj, jlo, jhi
944 integer :: gtype, ivar, localDE, n
945 integer :: locID, peID
946 integer :: lbnd(2),ubnd(2)
947!
948 integer, pointer :: deLabelList(:) => null()
949 integer, pointer :: deBlockList(:,:,:) => null()
950 integer, pointer :: i_glob(:) => null()
951 integer, pointer :: j_glob(:) => null()
952 integer, pointer :: PETmap(:) => null()
953!
954 integer (i4b), pointer :: ptrM(:,:) => null()
955!
956 real (dp), pointer :: ptrA(:,:) => null()
957 real (dp), pointer :: ptrX(:,:) => null()
958 real (dp), pointer :: ptrY(:,:) => null()
959!
960 character (len=40) :: name
961
962 character (len=*), parameter :: MyFile = &
963 & __FILE__//", CICE_SetGridArrays"
964!
965 TYPE (block) :: my_block
966 TYPE (ESMF_DELayout) :: delayout
967 TYPE (ESMF_DistGrid) :: distGrid
968 TYPE (ESMF_StaggerLoc) :: staggerLoc
969!
970 TYPE (ESMF_DistGridConnection), allocatable :: connectionList(:)
971!
972!-----------------------------------------------------------------------
973! Initialize return code flag to success state (no error).
974!-----------------------------------------------------------------------
975!
976 IF (esm_track) THEN
977 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetGridArrays', &
978 & ', PET', petrank
979 FLUSH (trac)
980 END IF
981 rc=esmf_success
982!
983!-----------------------------------------------------------------------
984! Set upper and lower bounds for each decomposition element (DE),
985! create layout, and boundary conditions.
986!-----------------------------------------------------------------------
987!
988 allocate ( deblocklist(2,2,nblocks_tot) )
989 allocate ( delabellist(nblocks_tot) )
990 allocate ( petmap(nblocks_tot) )
991!
992 DO n=1,nblocks_tot
993 delabellist(i)=n
994 CALL get_block_parameter (n, ilo=ilo, ihi=ihi, &
995 & jlo=jlo, jhi=jhi, &
996 & i_glob=i_glob, j_glob=j_glob)
997 deblocklist(1,1,n)=i_glob(ilo)
998 deblocklist(1,2,n)=i_glob(ihi)
999 deblocklist(2,1,n)=j_glob(jlo)
1000 deblocklist(2,2,n)=j_glob(jhi)
1001 CALL ice_distributiongetblockloc (distrb_info, n, peid, locid)
1002 petmap(n)=peid-1
1003 END DO
1004!
1005! Create decomposition elements layout.
1006!
1007 delayout=esmf_delayoutcreate(petmap, &
1008 & rc=rc)
1009 IF (esmf_logfounderror(rctocheck=rc, &
1010 & msg=esmf_logerr_passthru, &
1011 & line=__line__, &
1012 & file=myfile)) THEN
1013 RETURN
1014 END IF
1015!
1016! Connection between tiles: bipolar boundary condition at top row
1017! (nyg).
1018!
1019 allocate (connectionlist(2))
1020!
1021 CALL esmf_distgridconnectionset (connectionlist(1),
1022 & tileindexa=1, &
1023 & tileindexb=1, &
1024 & positionvector=(/ nx_global+1, &
1025 & 2*ny_global+1/), &
1026 & orientationvector=(/-1, -2/), &
1027 & rc=rc)
1028 IF (esmf_logfounderror(rctocheck=rc, &
1029 & msg=esmf_logerr_passthru, &
1030 & line=__line__, &
1031 & file=myfile)) THEN
1032 RETURN
1033 END IF
1034!
1035! Connectivity between tiles: periodic boundary condition along first
1036! dimension.
1037!
1038 CALL esmf_distgridconnectionset (connectionlist(2), &
1039 & tileindexa=1, &
1040 & tileindexb=1, &
1041 & positionvector=(/nx_global, 0/), &
1042 & rc=rc)
1043 IF (esmf_logfounderror(rctocheck=rc, &
1044 & msg=esmf_logerr_passthru, &
1045 & line=__line__, &
1046 & file=myfile)) THEN
1047 RETURN
1048 END IF
1049 deallocate (connectionlist)
1050!
1051!-----------------------------------------------------------------------
1052! Create DistGrid based on model domain decomposition.
1053!-----------------------------------------------------------------------
1054!
1055 distgrid=esmf_distgridcreate(minindex=(/ 1, 1 /), &
1056 & maxindex=(/ nx_global, ny_global /), &
1057 & deblocklist=deblocklist, &
1058 & delayout=delayout, &
1059 & connectionlist=connectionlist, &
1060 & rc=rc)
1061 IF (esmf_logfounderror(rctocheck=rc, &
1062 & msg=esmf_logerr_passthru, &
1063 & line=__line__, &
1064 & file=myfile)) THEN
1065 RETURN
1066 END IF
1067!
1068 deallocate (delabellist)
1069 deallocate (deblocklist)
1070 deallocate (petmap)
1071!
1072!-----------------------------------------------------------------------
1073! Set component grid coordinates.
1074!-----------------------------------------------------------------------
1075!
1076! Define component grid location type: Arakawa B-grid.
1077!
1078 IF (.not.allocated(models(iseaice)%mesh)) THEN
1079 allocate ( models(iseaice)%mesh(2) )
1080 models(iseaice)%mesh(1)%gtype=icenter ! T-cell
1081 models(iseaice)%mesh(2)%gtype=icorner ! UV-cell
1082 END IF
1083!
1084! Create ESMF Grid.
1085!
1086 models(iseaice)%grid(ng)=esmf_gridcreate(distgrid=distgrid, &
1087 & coordsys=esmf_coordsys_sph_deg, &
1088 & gridedgelwidth=(/ 0, 0 /), &
1089 & gridedgeuwidth=(/ 0, 1 /), &
1090 & name="cice_grid", &
1091 & rc=rc)
1092 IF (esmf_logfounderror(rctocheck=rc, &
1093 & msg=esmf_logerr_passthru, &
1094 & line=__line__, &
1095 & file=myfile)) THEN
1096 RETURN
1097 END IF
1098!
1099! Get number of local decomposition elements (DEs). Usually, a single
1100! DE is associated with each Persistent Execution Thread (PETs). Thus,
1101! localDEcount=1.
1102!
1103 CALL esmf_gridget (models(iseaice)%grid(ng), &
1104 & localdecount=localdecount, &
1105 & rc=rc)
1106 IF (esmf_logfounderror(rctocheck=rc, &
1107 & msg=esmf_logerr_passthru, &
1108 & line=__line__, &
1109 & file=myfile)) THEN
1110 RETURN
1111 END IF
1112!
1113! Mesh coordinates for each variable type.
1114!
1115 mesh_loop : DO ivar=1,ubound(models(iseaice)%mesh, dim=1)
1116!
1117! Set staggering type, Arakawa B-grid.
1118!
1119 SELECT CASE (models(iseaice)%mesh(ivar)%gtype)
1120 CASE (icorner)
1121 staggerloc=esmf_staggerloc_corner
1122 CASE (icenter)
1123 staggerloc=esmf_staggerloc_center
1124!
1125! Allocate storage for masking.
1126!
1127 CALL esmf_gridadditem (models(iseaice)%grid(ng), &
1128 & staggerloc=staggerloc, &
1129 & itemflag=esmf_griditem_mask, &
1130 & rc=rc)
1131 IF (esmf_logfounderror(rctocheck=rc, &
1132 & msg=esmf_logerr_passthru, &
1133 & line=__line__, &
1134 & file=myfile)) THEN
1135 RETURN
1136 END IF
1137 models(iseaice)%LandValue=0
1138 models(iseaice)%SeaValue=1
1139!
1140! Allocate storage for grid area.
1141!
1142 CALL esmf_gridadditem (models(iseaice)%grid(ng), &
1143 & staggerloc=staggerloc, &
1144 & itemflag=esmf_griditem_area, &
1145 & rc=rc)
1146 IF (esmf_logfounderror(rctocheck=rc, &
1147 & msg=esmf_logerr_passthru, &
1148 & line=__line__, &
1149 & file=myfile)) THEN
1150 RETURN
1151 END IF
1152 END SELECT
1153!
1154! Allocate coordinate storage associated with staggered grid type.
1155! No coordinate values are set yet.
1156!
1157 CALL esmf_gridaddcoord (models(iseaice)%grid(ng), &
1158 & staggerloc=staggerloc, &
1159 & rc=rc)
1160 IF (esmf_logfounderror(rctocheck=rc, &
1161 & msg=esmf_logerr_passthru, &
1162 & line=__line__, &
1163 & file=myfile)) THEN
1164 RETURN
1165 END IF
1166!
1167! Get pointers and set coordinates for the grid using the block
1168! decomposition.
1169!
1170 block_loop : DO blk=1,nblocks
1171 localde=blk-1
1172 my_block=get_block(blocks_ice(blk), blk)
1173 ilo=my_block%ilo
1174 ihi=my_block%ihi
1175 jlo=my_block%jlo
1176 jhi=my_block%jhi
1177!
1178 CALL esmf_gridgetcoord (models(iseaice)%grid(ng), &
1179 & coorddim=1, &
1180 & localde=localde, &
1181 & staggerloc=staggerloc, &
1182 & computationallbound=lbnd, &
1183 & computationalubound=ubnd, &
1184 & farrayptr=ptrx, &
1185 & rc=rc)
1186 IF (esmf_logfounderror(rctocheck=rc, &
1187 & msg=esmf_logerr_passthru, &
1188 & line=__line__, &
1189 & file=myfile)) THEN
1190 RETURN
1191 END IF
1192!
1193 CALL esmf_gridgetcoord (models(iseaice)%grid(ng), &
1194 & coorddim=2, &
1195 & localde=localde, &
1196 & staggerloc=staggerloc, &
1197 & farrayptr=ptry, &
1198 & rc=rc)
1199 IF (esmf_logfounderror(rctocheck=rc, &
1200 & msg=esmf_logerr_passthru, &
1201 & line=__line__, &
1202 & file=myfile)) THEN
1203 RETURN
1204 END IF
1205!
1206 CALL esmf_gridgetitem (models(iseaice)%grid(ng), &
1207 & localde=localde, &
1208 & staggerloc=staggerloc, &
1209 & itemflag=esmf_griditem_mask, &
1210 & farrayptr=ptrm, &
1211 & rc=rc)
1212 IF (esmf_logfounderror(rctocheck=rc, &
1213 & msg=esmf_logerr_passthru, &
1214 & line=__line__, &
1215 & file=myfile)) THEN
1216 RETURN
1217 END IF
1218!
1219 CALL esmf_gridgetitem (models(iseaice)%grid(ng), &
1220 & localde=localde, &
1221 & staggerloc=staggerloc, &
1222 & itemflag=esmf_griditem_area, &
1223 & farrayptr=ptra, &
1224 & rc=rc)
1225 IF (esmf_logfounderror(rctocheck=rc, &
1226 & msg=esmf_logerr_passthru, &
1227 & line=__line__, &
1228 & file=myfile)) THEN
1229 RETURN
1230 END IF
1231!
1232! Fill grid pointers.
1233!
1234 SELECT CASE (models(iseaice)%mesh(ivar)%gtype)
1235 CASE (icorner)
1236 DO jj=lbnd(2),ubnd(2)
1237 j=jj+jlo-lbnd(2)
1238 DO ii=lbnd(1),ubnd(1)
1239 i=ii+ilo-lbnd(1)
1240 ptrx(ii,jj)=ulon(i-1,j-1,blk)*rad_to_deg
1241 ptry(ii,jj)=ulat(i-1,j-1,blk)*rad_to_deg
1242 ptrm(ii,jj)=nint(uvm(i,j,blk))
1243 ptra(ii,jj)=tarea(i,j,blk)
1244 END DO
1245 END DO
1246 CASE (icenter)
1247 DO jj=lbnd(2),ubnd(2)
1248 j=jj+jlo-lbnd(2)
1249 DO ii=lbnd(1),ubnd(1)
1250 i=ii+ilo-lbnd(1)
1251 ptrx(ii,jj)=tlon(i,j,blk)*rad_to_deg
1252 ptry(ii,jj)=tlat(i,j,blk)*rad_to_deg
1253 ptrm(ii,jj)=nint(hm(i,j,blk))
1254 ptra(ii,jj)=tarea(i,j,blk)
1255 END DO
1256 END DO
1257 END SELECT
1258!
1259! Nullify pointers.
1260!
1261 IF ( associated(ptrx) ) nullify (ptrx)
1262 IF ( associated(ptry) ) nullify (ptry)
1263 IF ( associated(ptrm) ) nullify (ptrm)
1264 IF ( associated(ptra) ) nullify (ptra)
1265 END DO block_loop
1266!
1267! Debugging: write out component grid in VTK format.
1268!
1269 IF (debuglevel.ge.4) THEN
1270 gtype=models(iseaice)%mesh(ivar)%gtype
1271 CALL esmf_gridwritevtk (models(iseaice)%grid(ng), &
1272 & filename="cice_"// &
1273 & trim(gridtype(gtype))// &
1274 & "_point", &
1275 & staggerloc=staggerloc, &
1276 & rc=rc)
1277 IF (esmf_logfounderror(rctocheck=rc, &
1278 & msg=esmf_logerr_passthru, &
1279 & line=__line__, &
1280 & file=myfile)) THEN
1281 RETURN
1282 END IF
1283 END IF
1284 END DO mesh_loop
1285!
1286! Assign grid to gridded component.
1287!
1288 CALL esmf_gridcompset (model, &
1289 & grid=models(iseaice)%grid(ng), &
1290 & rc=rc)
1291 IF (esmf_logfounderror(rctocheck=rc, &
1292 & msg=esmf_logerr_passthru, &
1293 & line=__line__, &
1294 & file=myfile)) THEN
1295 RETURN
1296 END IF
1297!
1298 IF (esm_track) THEN
1299 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetGridArrays', &
1300 & ', PET', petrank
1301 FLUSH (trac)
1302 END IF
1303!
1304 RETURN

References mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, mod_esmf_esm::gridtype, mod_esmf_esm::icenter, mod_esmf_esm::icorner, mod_esmf_esm::iseaice, mod_esmf_esm::models, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by cice_setinitializep2().

Here is the caller graph for this function:

◆ cice_setinitializep1()

subroutine, private esmf_roms_mod::cice_setinitializep1 ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 244 of file esmf_ice_cice.h.

247!
248!=======================================================================
249! !
250! CICE component Phase 1 initialization: sets import and export !
251! fields long and short names into its respective state. !
252! !
253!=======================================================================
254!
255! Imported variable declarations.
256!
257 integer, intent(out) :: rc
258!
259 TYPE (ESMF_GridComp) :: model
260 TYPE (ESMF_State) :: ImportState
261 TYPE (ESMF_State) :: ExportState
262 TYPE (ESMF_Clock) :: clock
263!
264! Local variable declarations.
265!
266 integer :: i, ng
267!
268 character (len=100) :: CoupledSet, StateLabel
269 character (len=240) :: StandardName, ShortName
270
271 character (len=*), parameter :: MyFile = &
272 & __FILE__//", CICE_SetInitializeP1"
273!
274!-----------------------------------------------------------------------
275! Initialize return code flag to success state (no error).
276!-----------------------------------------------------------------------
277!
278 IF (esm_track) THEN
279 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetInitializeP1', &
280 & ', PET', petrank
281 FLUSH (trac)
282 END IF
283 rc=esmf_success
284!
285!-----------------------------------------------------------------------
286! Set CICE import state and fields.
287!-----------------------------------------------------------------------
288!
289! Add CICE import state(s). If nesting, each grid has its own import
290! state.
291!
292 importing : IF (nimport(iseaice).gt.0) THEN
293 DO ng=1,models(iseaice)%Ngrids
294 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
295 coupledset=trim(coupled(iseaice)%SetLabel(ng))
296 statelabel=trim(coupled(iseaice)%ImpLabel(ng))
297 CALL nuopc_addnestedstate (importstate, &
298 & cplset=trim(coupledset), &
299 & nestedstatename=trim(statelabel),&
300 & nestedstate=models(iseaice)% &
301 & importstate(ng), &
302 rc=rc)
303 IF (esmf_logfounderror(rctocheck=rc, &
304 & msg=esmf_logerr_passthru, &
305 & line=__line__, &
306 & file=myfile)) THEN
307 RETURN
308 END IF
309!
310! Add fields import state.
311!
312 DO i=1,nimport(iseaice)
313 standardname=models(iseaice)%ImportField(i)%standard_name
314 shortname =models(iseaice)%ImportField(i)%short_name
315 CALL nuopc_advertise (models(iseaice)%ImportState(ng), &
316 & standardname=trim(standardname), &
317 & name=trim(shortname), &
318 & rc=rc)
319 IF (esmf_logfounderror(rctocheck=rc, &
320 & msg=esmf_logerr_passthru, &
321 & line=__line__, &
322 & file=myfile)) THEN
323 RETURN
324 END IF
325 END DO
326 END IF
327 END DO
328 END IF importing
329!
330!-----------------------------------------------------------------------
331! Set CICE export state and fields.
332!-----------------------------------------------------------------------
333!
334! Add CICE import state. If nesting, each grid has its own import
335! state.
336!
337 exporting : IF (nexport(iseaice).gt.0) THEN
338 DO ng=1,models(iseaice)%Ngrids
339 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
340 coupledset=trim(coupled(iseaice)%SetLabel(ng))
341 statelabel=trim(coupled(iseaice)%ExpLabel(ng))
342 CALL nuopc_addnestedstate (exportstate, &
343 & cplset=trim(coupledset), &
344 & nestedstatename=trim(statelabel),&
345 & nestedstate=models(iseaice)% &
346 & exportstate(ng), &
347 rc=rc)
348 IF (esmf_logfounderror(rctocheck=rc, &
349 & msg=esmf_logerr_passthru, &
350 & line=__line__, &
351 & file=myfile)) THEN
352 RETURN
353 END IF
354!
355! Add fields to export state.
356!
357 DO i=1,nexport(iseaice)
358 standardname=models(iseaice)%ExportField(i)%standard_name
359 shortname =models(iseaice)%ExportField(i)%short_name
360 CALL nuopc_advertise (models(iseaice)%ExportState(ng), &
361 & standardname=trim(standardname), &
362 & name=trim(shortname), &
363 & rc=rc)
364 IF (esmf_logfounderror(rctocheck=rc, &
365 & msg=esmf_logerr_passthru, &
366 & line=__line__, &
367 & file=myfile)) THEN
368 RETURN
369 END IF
370 END DO
371 END IF
372 END DO
373 END IF exporting
374!
375 IF (esm_track) THEN
376 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetInitializeP1', &
377 & ', PET', petrank
378 FLUSH (trac)
379 END IF
380!
381 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::esm_track, mod_esmf_esm::iseaice, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::nimport, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

◆ cice_setinitializep2()

subroutine, private esmf_roms_mod::cice_setinitializep2 ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 384 of file esmf_ice_cice.h.

387!
388!=======================================================================
389! !
390! CICE component Phase 2 initialization: Initializes CICE, sets !
391! component grid, and adds import and export fields to respective !
392! states. !
393! !
394!=======================================================================
395!
396! Imported variable declarations.
397!
398 integer, intent(out) :: rc
399!
400 TYPE (ESMF_GridComp) :: model
401 TYPE (ESMF_State) :: ImportState
402 TYPE (ESMF_State) :: ExportState
403 TYPE (ESMF_Clock) :: clock
404!
405! Local variable declarations.
406!
407 integer :: MyComm, localPET, ng, PETcount
408!
409 character (len=*), parameter :: MyFile = &
410 & __FILE__//", CICE_SetInitializeP2"
411!
412 TYPE (ESMF_Time) :: CurrentTime, StartTime
413 TYPE (ESMF_VM) :: vm
414!
415!-----------------------------------------------------------------------
416! Initialize return code flag to success state (no error).
417!-----------------------------------------------------------------------
418!
419 IF (esm_track) THEN
420 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetInitializeP2', &
421 & ', PET', petrank
422 FLUSH (trac)
423 END IF
424 rc=esmf_success
425!
426!-----------------------------------------------------------------------
427! Querry the Virtual Machine (VM) parallel environmemt for the MPI
428! communicator handle and current node rank.
429!-----------------------------------------------------------------------
430!
431 CALL esmf_gridcompget (model, &
432 & vm=vm, &
433 & rc=rc)
434 IF (esmf_logfounderror(rctocheck=rc, &
435 & msg=esmf_logerr_passthru, &
436 & line=__line__, &
437 & file=myfile)) THEN
438 RETURN
439 END IF
440!
441 CALL esmf_vmget (vm, &
442 & localpet=localpet, &
443 & petcount=petcount, &
444 & mpicommunicator=mycomm, &
445 & rc=rc)
446 IF (esmf_logfounderror(rctocheck=rc, &
447 & msg=esmf_logerr_passthru, &
448 & line=__line__, &
449 & file=myfile)) THEN
450 RETURN
451 END IF
452!
453!-----------------------------------------------------------------------
454! Initialize CICE component.
455!-----------------------------------------------------------------------
456!
457 CALL cice_initialize (mycomm)
458!
459!-----------------------------------------------------------------------
460! Set-up grid and load coordinate data.
461!-----------------------------------------------------------------------
462!
463 DO ng=1,models(iseaice)%Ngrids
464 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
465 CALL cice_setgridarrays (ng, model, rc)
466 IF (esqmf_logfounderror(rctocheck=rc, &
467 & msg=esmf_logerr_passthru, &
468 & line=__line__, &
469 & file=myfile)) THEN
470 RETURN
471 END IF
472 END IF
473 END DO
474!
475!-----------------------------------------------------------------------
476! Set-up fields and register to import/export states.
477!-----------------------------------------------------------------------
478!
479 DO ng=1,models(iseaice)%Ngrids
480 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
481 CALL cice_setstates (ng, model, rc)
482 IF (esqmf_logfounderror(rctocheck=rc, &
483 & msg=esmf_logerr_passthru, &
484 & line=__line__, &
485 & file=myfile)) THEN
486 RETURN
487 END IF
488 END IF
489 END DO
490!
491 IF (esm_track) THEN
492 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetInitializeP2', &
493 & ', PET', petrank
494 FLUSH (trac)
495 END IF
496!
497 RETURN

References cice_setgridarrays(), cice_setstates(), mod_esmf_esm::coupled, mod_esmf_esm::esm_track, mod_esmf_esm::iseaice, mod_esmf_esm::models, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Here is the call graph for this function:

◆ cice_setstates()

subroutine, private esmf_roms_mod::cice_setstates ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1307 of file esmf_ice_cice.h.

1308!
1309!=======================================================================
1310! !
1311! Adds CICE component export and import fields into its respective !
1312! state. !
1313! !
1314!=======================================================================
1315!
1316 USE ice_domain, ONLY : nblocks
1317 USE ice_domain_size, ONLY : max_blocks
1318!
1319! Imported variable declarations.
1320!
1321 integer, intent(in) :: ng
1322 integer, intent(out) :: rc
1323!
1324 TYPE (ESMF_GridComp) :: model
1325!
1326! Local variable declarations.
1327!
1328 integer :: i, id
1329 integer :: blk, localDE
1330 integer :: localPET
1331 integer :: ExportCount, ImportCount
1332!
1333 real (dp), pointer :: ptr3d(:,:,:) => null()
1334!
1335 character (len=*), parameter :: MyFile = &
1336 & __FILE__//", CICE_SetStates"
1337
1338 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
1339 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
1340!
1341 TYPE (ESMF_ArraySpec) :: arraySpec3d
1342 TYPE (ESMF_Field) :: field
1343 TYPE (ESMF_StaggerLoc) :: staggerLoc
1344 TYPE (ESMF_VM) :: vm
1345!
1346!-----------------------------------------------------------------------
1347! Initialize return code flag to success state (no error).
1348!-----------------------------------------------------------------------
1349!
1350 IF (esm_track) THEN
1351 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetStates', &
1352 & ', PET', petrank
1353 FLUSH (trac)
1354 END IF
1355 rc=esmf_success
1356!
1357!-----------------------------------------------------------------------
1358! Query gridded component.
1359!-----------------------------------------------------------------------
1360!
1361! Get import and export states.
1362!
1363 CALL esmf_gridcompget (model, &
1364 & localpet=localpet, &
1365 & vm=vm, &
1366 & rc=rc)
1367 IF (esmf_logfounderror(rctocheck=rc, &
1368 & msg=esmf_logerr_passthru, &
1369 & line=__line__, &
1370 & file=myfile)) THEN
1371 RETURN
1372 END IF
1373!
1374!-----------------------------------------------------------------------
1375! Set a 3D floating-point array descriptor. CICE import and export
1376! fields are dimensioned (nx_global, ny_global, max_blocks).
1377!-----------------------------------------------------------------------
1378!
1379 CALL esmf_arrayspecset (arrayspec3d, &
1380 & typekind=esmf_typekind_r8, &
1381 & rank=3, &
1382 & rc=rc)
1383 IF (esmf_logfounderror(rctocheck=rc, &
1384 & msg=esmf_logerr_passthru, &
1385 & line=__line__, &
1386 & file=myfile)) THEN
1387 RETURN
1388 END IF
1389!
1390!-----------------------------------------------------------------------
1391! Add export fields into export state.
1392!-----------------------------------------------------------------------
1393!
1394 exporting : IF (nexport(iseaice).gt.0) THEN
1395!
1396! Get number of fields to export.
1397!
1398 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
1399 & itemcount=exportcount, &
1400 & rc=rc)
1401 IF (esmf_logfounderror(rctocheck=rc, &
1402 & msg=esmf_logerr_passthru, &
1403 & line=__line__, &
1404 & file=myfile)) THEN
1405 RETURN
1406 END IF
1407!
1408! Get a list of export fields names.
1409!
1410 IF (.not.allocated(exportnamelist)) THEN
1411 allocate ( exportnamelist(exportcount) )
1412 END IF
1413 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
1414 & itemnamelist=exportnamelist, &
1415 & rc=rc)
1416 IF (esmf_logfounderror(rctocheck=rc, &
1417 & msg=esmf_logerr_passthru, &
1418 & line=__line__, &
1419 & file=myfile)) THEN
1420 RETURN
1421 END IF
1422!
1423! Set export field(s).
1424!
1425 DO i=1,exportcount
1426 id=field_index(models(iseaice)%ExportField, exportnamelist(i))
1427!
1428 IF (nuopc_isconnected(models(iseaice)%ExportState(ng), &
1429 & fieldname=trim(exportnamelist(i)), &
1430 & rc=rc)) THEN
1431!
1432! Set staggering type.
1433!
1434 SELECT CASE (models(iseaice)%ExportField(id)%gtype)
1435 CASE (icenter)
1436 staggerloc=esmf_staggerloc_center
1437 CASE (icorner)
1438 staggerloc=esmf_staggerloc_corner
1439 END SELECT
1440!
1441! Create 2D field from the Grid and arraySpec.
1442!
1443 field=esmf_fieldcreate(models(iseaice)%grid(ng), &
1444 & arrayspec3d, &
1445 & indexflag=esmf_index_delocal, &
1446 & staggerloc=staggerloc, &
1447 & ungriddedlbound=(/1/), &
1448 & ungriddedubound=(/max_blocks/), &
1449 & name=trim(exportnamelist(i)), &
1450 & rc=rc)
1451 IF (esmf_logfounderror(rctocheck=rc, &
1452 & msg=esmf_logerr_passthru, &
1453 & line=__line__, &
1454 & file=myfile)) THEN
1455 RETURN
1456 END IF
1457!
1458! Put data into state. Use CICE block decomposition.
1459!
1460 DO blk=1,nblocks
1461 localde=blk-1
1462!
1463! Get pointer to DE-local memory allocation within field.
1464!
1465 CALL esmf_fieldget (field, &
1466 & localde=localde, &
1467 & farrayptr=ptr3d, &
1468 & rc=rc)
1469 IF (esmf_logfounderror(rctocheck=rc, &
1470 & msg=esmf_logerr_passthru, &
1471 & line=__line__, &
1472 & file=myfile)) THEN
1473 RETURN
1474 END IF
1475!
1476! Initialize pointer.
1477!
1478 ptr3d=missing_dp
1479!
1480! Nullify pointer to make sure that it does not point on a random part
1481! in the memory.
1482!
1483 IF ( associated(ptr3d) ) nullify (ptr3d)
1484 END DO
1485!
1486! Add field export state.
1487!
1488 CALL nuopc_realize (exportstate, &
1489 & field=field, &
1490 & rc=rc)
1491 IF (esmf_logfounderror(rctocheck=rc, &
1492 & msg=esmf_logerr_passthru, &
1493 & line=__line__, &
1494 & file=myfile)) THEN
1495 RETURN
1496 END IF
1497!
1498! Remove field from export state because it is not connected.
1499!
1500 ELSE
1501 IF (localpet.eq.0) THEN
1502 WRITE (cplout,10) trim(exportnamelist(i)), &
1503 & 'Export State: ', &
1504 & trim(coupled(iseaice)%ExpLabel(ng))
1505 END IF
1506 CALL esmf_stateremove (models(iseaice)%ExportState(ng), &
1507 & (/ trim(exportnamelist(i)) /), &
1508 & rc=rc)
1509 IF (esmf_logfounderror(rctocheck=rc, &
1510 & msg=esmf_logerr_passthru, &
1511 & line=__line__, &
1512 & file=myfile)) THEN
1513 RETURN
1514 END IF
1515 END IF
1516 END DO
1517!
1518! Deallocate arrays.
1519!
1520 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
1521!
1522 END IF exporting
1523!
1524!-----------------------------------------------------------------------
1525! Add import fields into import state.
1526!-----------------------------------------------------------------------
1527!
1528 importing : IF (nimport(iseaice).gt.0) THEN
1529!
1530! Get number of fields to import.
1531!
1532 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
1533 & itemcount=importcount, &
1534 & rc=rc)
1535 IF (esmf_logfounderror(rctocheck=rc, &
1536 & msg=esmf_logerr_passthru, &
1537 & line=__line__, &
1538 & file=myfile)) THEN
1539 RETURN
1540 END IF
1541!
1542! Get a list of import fields names.
1543!
1544 IF (.not.allocated(importnamelist)) THEN
1545 allocate (importnamelist(importcount))
1546 END IF
1547 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
1548 & itemnamelist=importnamelist, &
1549 & rc=rc)
1550 IF (esmf_logfounderror(rctocheck=rc, &
1551 & msg=esmf_logerr_passthru, &
1552 & line=__line__, &
1553 & file=myfile)) THEN
1554 RETURN
1555 END IF
1556!
1557! Set import field(s).
1558!
1559 DO i=1,importcount
1560 id=field_index(models(iseaice)%ImportField, importnamelist(i))
1561!
1562 IF (nuopc_isconnected(models(iseaice)%ImportState(ng), &
1563 & fieldname=trim(importnamelist(i)), &
1564 & rc=rc)) THEN
1565
1566!
1567! Set staggering type.
1568!
1569 SELECT CASE (models(iseaice)%ImportField(id)%gtype)
1570 CASE (icenter)
1571 staggerloc=esmf_staggerloc_center
1572 CASE (icorner)
1573 staggerloc=esmf_staggerloc_corner
1574 END SELECT
1575!
1576! Create field from the Grid, arraySpec.
1577!
1578 field=esmf_fieldcreate(models(iseaice)%grid(ng), &
1579 & arrayspec3d, &
1580 & indexflag=esmf_index_delocal, &
1581 & staggerloc=staggerloc, &
1582 & ungriddedlbound=(/1/), &
1583 & ungriddedubound=(/max_blocks/), &
1584 & name=trim(importnamelist(i)), &
1585 & rc=rc)
1586 IF (esmf_logfounderror(rctocheck=rc, &
1587 & msg=esmf_logerr_passthru, &
1588 & line=__line__, &
1589 & file=myfile)) THEN
1590 RETURN
1591 END IF
1592!
1593! Put data into state. Use CICE block decomposition.
1594!
1595 DO blk=1,nblocks
1596 localde=blk-1
1597!
1598! Get pointer to DE-local memory allocation within field.
1599!
1600 CALL esmf_fieldget (field, &
1601 & localde=localde, &
1602 & farrayptr=ptr3d, &
1603 & rc=rc)
1604 IF (esmf_logfounderror(rctocheck=rc, &
1605 & msg=esmf_logerr_passthru, &
1606 & line=__line__, &
1607 & file=myfile)) THEN
1608 RETURN
1609 END IF
1610!
1611! Initialize pointer.
1612!
1613 ptr3d=missing_dp
1614!
1615! Nullify pointer to make sure that it does not point on a random
1616! part in the memory.
1617!
1618 IF (associated(ptr3d)) nullify (ptr3d)
1619 END DO
1620!
1621! Add field import state.
1622!
1623 CALL nuopc_realize (models(iseaice)%ImportState(ng), &
1624 & field=field, &
1625 & rc=rc)
1626 IF (esmf_logfounderror(rctocheck=rc, &
1627 & msg=esmf_logerr_passthru, &
1628 & line=__line__, &
1629 & file=myfile)) THEN
1630 RETURN
1631 END IF
1632!
1633! Remove field from import state because it is not connected.
1634!
1635 ELSE
1636 IF (localpet.eq.0) THEN
1637 WRITE (cplout,10) trim(importnamelist(i)), &
1638 & 'Import State: ', &
1639 & trim(coupled(iseaice)%ImpLabel(ng))
1640 END IF
1641 CALL esmf_stateremove (models(iseaice)%ImportState(ng), &
1642 & trim(importnamelist(i)), &
1643 & rc=rc)
1644 IF (esmf_logfounderror(rctocheck=rc, &
1645 & msg=esmf_logerr_passthru, &
1646 & line=__line__, &
1647 & file=myfile)) THEN
1648 RETURN
1649 END IF
1650 END IF
1651 END DO
1652!
1653! Deallocate arrays.
1654!
1655 IF (allocated(importnamelist)) deallocate (importnamelist)
1656!
1657 END IF importing
1658!
1659 IF (esm_track) THEN
1660 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetStates', &
1661 & ', PET', petrank
1662 FLUSH (trac)
1663 END IF
1664!
1665 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_esmf_esm::esm_track, mod_esmf_esm::field_index(), mod_esmf_esm::icenter, mod_esmf_esm::icorner, mod_esmf_esm::iseaice, mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::nimport, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by cice_setinitializep2().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_setservices()

subroutine, public esmf_roms_mod::ice_setservices ( type (esmf_gridcomp) model,
integer, intent(out) rc )

Definition at line 100 of file esmf_ice_cice.h.

101!
102!=======================================================================
103! !
104! Sets CICE component shared-object entry points for "initialize", !
105! "run", and "finalize" by using NUOPC generic methods. !
106! !
107!=======================================================================
108!
109! Imported variable declarations.
110!
111 integer, intent(out) :: rc
112!
113 TYPE (ESMF_GridComp) :: model
114!
115! Local variable declarations.
116!
117 character (len=*), parameter :: MyFile = &
118 & __FILE__//", ICE_SetServices"
119!
120!-----------------------------------------------------------------------
121! Initialize return code flag to success state (no error).
122!-----------------------------------------------------------------------
123!
124 IF (esm_track) THEN
125 WRITE (trac,'(a,a,i0)') '==> Entering ICE_SetServices', &
126 & ', PET', petrank
127 FLUSH (trac)
128 END IF
129 rc=esmf_success
130
131!-----------------------------------------------------------------------
132! Register NUOPC generic routines.
133!-----------------------------------------------------------------------
134!
135 CALL nuopc_compderive (model, &
136 & nuopc_setservices, &
137 & rc=rc)
138 IF (esmf_logfounderror(rctocheck=rc, &
139 & msg=esmf_logerr_passthru, &
140 & line=__line__, &
141 & file=myfile)) THEN
142 RETURN
143 END IF
144!
145!-----------------------------------------------------------------------
146! Register initialize routines.
147!-----------------------------------------------------------------------
148!
149! Set routine for Phase 1 initialization (import and export fields).
150!
151 CALL nuopc_compsetentrypoint (model, &
152 & methodflag=esmf_method_initialize, &
153 & phaselabellist=(/"IPDv00p1"/), &
154 & userroutine=cice_initializep1, &
155 & rc=rc)
156 IF (esmf_logfounderror(rctocheck=rc, &
157 & msg=esmf_logerr_passthru, &
158 & line=__line__, &
159 & file=myfile)) THEN
160 RETURN
161 END IF
162!
163! Set routine for Phase 2 initialization (exchange arrays).
164!
165 CALL nuopc_compsetentrypoint (model, &
166 & methodflag=esmf_method_initialize, &
167 & phaselabellist=(/"IPDv00p2"/), &
168 & userroutine=cice_initializep2, &
169 & rc=rc)
170 IF (esmf_logfounderror(rctocheck=rc, &
171 & msg=esmf_logerr_passthru, &
172 & line=__line__, &
173 & file=myfile)) THEN
174 RETURN
175 END IF
176!
177!-----------------------------------------------------------------------
178! Attach CICE component phase independent specializing methods.
179!-----------------------------------------------------------------------
180!
181! Set routine for export initial/restart fields.
182!
183 CALL nuopc_compspecialize (model, &
184 & speclabel=nuopc_label_datainitialize, &
185 & specroutine=cice_datainit, &
186 & rc=rc)
187 IF (esmf_logfounderror(rctocheck=rc, &
188 & msg=esmf_logerr_passthru, &
189 & line=__line__, &
190 & file=myfile)) THEN
191 RETURN
192 END IF
193!
194! Set routine for setting CICE clock.
195!
196 CALL nuopc_compspecialize (model, &
197 & speclabel=nuopc_label_setclock, &
198 & specroutine=cice_setclock, &
199 & rc=rc)
200 IF (esmf_logfounderror(rctocheck=rc, &
201 & msg=esmf_logerr_passthru, &
202 & line=__line__, &
203 & file=myfile)) THEN
204 RETURN
205 END IF
206!
207! Set routine for time-stepping CICE component.
208!
209 CALL nuopc_compspecialize (model, &
210 & speclabel=nuopc_label_advance, &
211 & specroutine=cice_modeladvance, &
212 & rc=rc)
213 IF (esmf_logfounderror(rctocheck=rc, &
214 & msg=esmf_logerr_passthru, &
215 & line=__line__, &
216 & file=myfile)) THEN
217 RETURN
218 END IF
219!
220!-----------------------------------------------------------------------
221! Register CICE finalize routine.
222!-----------------------------------------------------------------------
223!
224 CALL esmf_gridcompsetentrypoint (model, &
225 & methodflag=esmf_method_finalize, &
226 & userroutine=cice_setfinalize, &
227 & rc=rc)
228 IF (esmf_logfounderror(rctocheck=rc, &
229 & msg=esmf_logerr_passthru, &
230 & line=__line__, &
231 & file=myfile)) THEN
232 RETURN
233 END IF
234!
235 IF (esm_track) THEN
236 WRITE (trac,'(a,a,i0)') '<== Exiting ICE_SetServices', &
237 & ', PET', petrank
238 FLUSH (trac)
239 END IF
240!
241 RETURN

References cice_datainit(), cice_modeladvance(), cice_setclock(), cice_setfinalize(), mod_esmf_esm::esm_track, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by esmf_esm_mod::esm_setmodelservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_checkimport()

subroutine, private esmf_roms_mod::roms_checkimport ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1299 of file esmf_roms.h.

1300!
1301!=======================================================================
1302! !
1303! Checks if ROMS component import field is at the correct time. !
1304! !
1305!=======================================================================
1306!
1307! Imported variable declarations.
1308!
1309 integer, intent(out) :: rc
1310!
1311 TYPE (ESMF_GridComp) :: model
1312!
1313! Local variable declarations.
1314!
1315 logical :: IsValid, atCorrectTime
1316!
1317 integer :: ImportCount, i, is, localPET, ng
1318!
1319 real (dp) :: TcurrentInSeconds
1320!
1321 character (len=22) :: DriverTimeString, FieldTimeString
1322
1323 character (len=*), parameter :: MyFile = &
1324 & __FILE__//", ROMS_CheckImport"
1325!
1326 character (ESMF_MAXSTR) :: string, FieldName
1327 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
1328!
1329 TYPE (ESMF_Clock) :: DriverClock
1330 TYPE (ESMF_Field) :: field
1331 TYPE (ESMF_Time) :: StartTime, CurrentTime
1332 TYPE (ESMF_Time) :: DriverTime, FieldTime
1333 TYPE (ESMF_TimeInterval) :: TimeStep
1334 TYPE (ESMF_VM) :: vm
1335!
1336!-----------------------------------------------------------------------
1337! Initialize return code flag to success state (no error).
1338!-----------------------------------------------------------------------
1339!
1340 IF (esm_track) THEN
1341 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_CheckImport', &
1342 & ', PET', petrank
1343 FLUSH (trac)
1344 END IF
1345 rc=esmf_success
1346!
1347!-----------------------------------------------------------------------
1348! Query component.
1349!-----------------------------------------------------------------------
1350!
1351 CALL nuopc_modelget (model, &
1352 & driverclock=driverclock, &
1353 & rc=rc)
1354 IF (esmf_logfounderror(rctocheck=rc, &
1355 & msg=esmf_logerr_passthru, &
1356 & line=__line__, &
1357 & file=myfile)) THEN
1358 RETURN
1359 END IF
1360!
1361 CALL esmf_gridcompget (model, &
1362 & localpet=localpet, &
1363 & vm=vm, &
1364 & rc=rc)
1365 IF (esmf_logfounderror(rctocheck=rc, &
1366 & msg=esmf_logerr_passthru, &
1367 & line=__line__, &
1368 & file=myfile)) THEN
1369 RETURN
1370 END IF
1371!
1372!-----------------------------------------------------------------------
1373! Get the start time and current time from driver clock.
1374!-----------------------------------------------------------------------
1375!
1376 CALL esmf_clockget (driverclock, &
1377 & timestep=timestep, &
1378 & starttime=starttime, &
1379 & currtime=drivertime, &
1380 & rc=rc)
1381 IF (esmf_logfounderror(rctocheck=rc, &
1382 & msg=esmf_logerr_passthru, &
1383 & line=__line__, &
1384 & file=myfile)) THEN
1385 RETURN
1386 END IF
1387!
1388! Adjust driver clock for semi-implicit coupling.
1389
1390 IF (couplingtype.eq.1) THEN
1391 currenttime=drivertime ! explicit coupling
1392 ELSE
1393 currenttime=drivertime+timestep ! semi-implicit coupling
1394 END IF
1395!
1396 CALL esmf_timeget (currenttime, &
1397 & s_r8=tcurrentinseconds, &
1398 & timestringisofrac=drivertimestring, &
1399 & rc=rc)
1400 IF (esmf_logfounderror(rctocheck=rc, &
1401 & msg=esmf_logerr_passthru, &
1402 & line=__line__, &
1403 & file=myfile)) THEN
1404 RETURN
1405 END IF
1406 is=index(drivertimestring, 'T') ! remove 'T' in
1407 IF (is.gt.0) drivertimestring(is:is)=' ' ! ISO 8601 format
1408!
1409!-----------------------------------------------------------------------
1410! Get list of import fields.
1411!-----------------------------------------------------------------------
1412!
1413 IF (nimport(iroms).gt.0) THEN
1414 nested_loop : DO ng=1,models(iroms)%Ngrids
1415 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1416 CALL esmf_stateget (models(iroms)%ImportState(ng), &
1417 & itemcount=importcount, &
1418 & rc=rc)
1419 IF (esmf_logfounderror(rctocheck=rc, &
1420 & msg=esmf_logerr_passthru, &
1421 & line=__line__, &
1422 & file=myfile)) THEN
1423 RETURN
1424 END IF
1425!
1426 IF (.not.allocated(importnamelist)) THEN
1427 allocate ( importnamelist(importcount) )
1428 END IF
1429!
1430 CALL esmf_stateget (models(iroms)%ImportState(ng), &
1431 & itemnamelist=importnamelist, &
1432 & rc=rc)
1433 IF (esmf_logfounderror(rctocheck=rc, &
1434 & msg=esmf_logerr_passthru, &
1435 & line=__line__, &
1436 & file=myfile)) THEN
1437 RETURN
1438 END IF
1439!
1440!-----------------------------------------------------------------------
1441! Only check fields in the ImportState object.
1442!-----------------------------------------------------------------------
1443!
1444 field_loop : DO i=1,importcount
1445 fieldname=trim(importnamelist(i))
1446 CALL esmf_stateget (models(iroms)%ImportState(ng), &
1447 & itemname=trim(fieldname), &
1448 & field=field, &
1449 & rc=rc)
1450 IF (esmf_logfounderror(rctocheck=rc, &
1451 & msg=esmf_logerr_passthru, &
1452 & line=__line__, &
1453 & file=myfile)) THEN
1454 RETURN
1455 END IF
1456!
1457! If debugging, report field timestamp.
1458!
1459 IF (debuglevel.gt.1) THEN
1460 CALL nuopc_gettimestamp (field, &
1461 & isvalid = isvalid, &
1462 & time = fieldtime, &
1463 & rc = rc)
1464 IF (esmf_logfounderror(rctocheck=rc, &
1465 & msg=esmf_logerr_passthru, &
1466 & line=__line__, &
1467 & file=myfile)) THEN
1468 RETURN
1469 END IF
1470!
1471 IF (isvalid) THEN
1472 CALL esmf_timeget (fieldtime, &
1473 & timestringisofrac = fieldtimestring, &
1474 & rc=rc)
1475 IF (esmf_logfounderror(rctocheck=rc, &
1476 & msg=esmf_logerr_passthru, &
1477 & line=__line__, &
1478 & file=myfile)) THEN
1479 RETURN
1480 END IF
1481 is=index(fieldtimestring, 'T') ! remove 'T'
1482 IF (is.gt.0) fieldtimestring(is:is)=' '
1483!
1484 IF (localpet.eq.0) THEN
1485 WRITE (cplout,10) trim(fieldname), &
1486 & trim(fieldtimestring), &
1487 & trim(drivertimestring)
1488 END IF
1489 END IF
1490 END IF
1491!
1492! Check if import field is at the correct time.
1493!
1494 string='ROMS_CheckImport - '//trim(fieldname)//' field'
1495!
1496 atcorrecttime=nuopc_isattime(field, &
1497 & currenttime, &
1498 & rc=rc)
1499 IF (esmf_logfounderror(rctocheck=rc, &
1500 & msg=esmf_logerr_passthru, &
1501 & line=__line__, &
1502 & file=myfile)) THEN
1503 RETURN
1504 END IF
1505!
1506 IF (.not.atcorrecttime) THEN
1507 CALL report_timestamp (field, currenttime, &
1508 & localpet, trim(string), rc)
1509!
1510 string='NUOPC INCOMPATIBILITY DETECTED: Import '// &
1511 & 'Fields not at correct time'
1512 CALL esmf_logseterror(esmf_rc_not_valid, &
1513 & msg=trim(string), &
1514 & line=__line__, &
1515 & file=myfile, &
1516 & rctoreturn=rc)
1517 RETURN
1518 END IF
1519 END DO field_loop
1520 IF (allocated(importnamelist)) deallocate (importnamelist)
1521 END IF
1522 END DO nested_loop
1523 END IF
1524!
1525 IF (esm_track) THEN
1526 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_CheckImport', &
1527 & ', PET', petrank
1528 FLUSH (trac)
1529 END IF
1530!
1531 10 FORMAT (1x,'ROMS_CheckImport - ',a,':',t32,'TimeStamp = ',a, &
1532 & ', DriverTime = ',a)
1533!
1534 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::couplingtype, mod_esmf_esm::cplout, mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, mod_esmf_esm::iroms, mod_esmf_esm::models, mod_esmf_esm::nimport, mod_esmf_esm::petrank, mod_esmf_esm::report_timestamp(), mod_scalars::time, mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_datainit()

subroutine, private esmf_roms_mod::roms_datainit ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 770 of file esmf_roms.h.

771!
772!=======================================================================
773! !
774! Exports ROMS component fields during initialization or restart. !
775! !
776!=======================================================================
777!
778! Imported variable declarations.
779!
780 integer, intent(out) :: rc
781!
782 TYPE (ESMF_GridComp) :: model
783!
784! Local variable declarations.
785!
786 integer :: ng
787!
788 character (len=*), parameter :: MyFile = &
789 & __FILE__//", ROMS_DataInit"
790!
791 TYPE (ESMF_Time) :: CurrentTime
792!
793!-----------------------------------------------------------------------
794! Initialize return code flag to success state (no error).
795!-----------------------------------------------------------------------
796!
797 IF (esm_track) THEN
798 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_DataInit', &
799 & ', PET', petrank
800 FLUSH (trac)
801 END IF
802 rc=esmf_success
803!
804!-----------------------------------------------------------------------
805! Get gridded component clock current time.
806!-----------------------------------------------------------------------
807!
808 CALL esmf_clockget (clockinfo(iroms)%Clock, &
809 & currtime=currenttime, &
810 & rc=rc)
811 IF (esmf_logfounderror(rctocheck=rc, &
812 & msg=esmf_logerr_passthru, &
813 & line=__line__, &
814 & file=myfile)) THEN
815 RETURN
816 END IF
817!
818!-----------------------------------------------------------------------
819! Export initialization or restart fields.
820!-----------------------------------------------------------------------
821!
822 IF (nexport(iroms).gt.0) THEN
823 DO ng=1,models(iroms)%Ngrids
824 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
825 CALL roms_export (ng, model, rc)
826 IF (esmf_logfounderror(rctocheck=rc, &
827 & msg=esmf_logerr_passthru, &
828 & line=__line__, &
829 & file=myfile)) THEN
830 RETURN
831 END IF
832 END IF
833 END DO
834 END IF
835!
836 IF (esm_track) THEN
837 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_DataInit', &
838 & ', PET', petrank
839 FLUSH (trac)
840 END IF
841!
842 RETURN

References mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, mod_esmf_esm::esm_track, mod_esmf_esm::iroms, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::petrank, roms_export(), and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_export()

subroutine, private esmf_roms_mod::roms_export ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 4397 of file esmf_roms.h.

4398!
4399!=======================================================================
4400! !
4401! Exports ROMS fields to other coupled gridded components. !
4402! !
4403!=======================================================================
4404!
4405! Imported variable declarations.
4406!
4407 integer, intent(in) :: ng
4408 integer, intent(out) :: rc
4409!
4410 TYPE (ESMF_GridComp) :: model
4411!
4412! Local variable declarations.
4413!
4414 logical :: get_barotropic
4415 logical :: get_SurfaceCurrent
4416!
4417 integer :: Istr, Iend, Jstr, Jend
4418 integer :: IstrR, IendR, JstrR, JendR
4419 integer :: LBi, UBi, LBj, UBj
4420 integer :: ExportCount
4421 integer :: localDE, localDEcount, localPET, tile
4422 integer :: year, month, day, hour, minutes, seconds, sN, SD
4423 integer :: ifld, i, is, j
4424!
4425 real (dp) :: Fmin(1), Fmax(1), Fval, MyFmin(1), MyFmax(1)
4426!
4427 real (dp), pointer :: ptr2d(:,:) => null()
4428!
4429 real (dp), allocatable :: Ubar(:,:), Vbar(:,:)
4430 real (dp), allocatable :: Usur(:,:), Vsur(:,:)
4431!
4432 character (len=22) :: Time_CurrentString
4433
4434 character (len=:), allocatable :: fldname
4435
4436 character (len=*), parameter :: MyFile = &
4437 & __FILE__//", ROMS_Export"
4438
4439 character (ESMF_MAXSTR) :: cname, ofile
4440 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
4441!
4442 TYPE (ESMF_Field) :: field
4443 TYPE (ESMF_Time) :: CurrentTime
4444 TYPE (ESMF_VM) :: vm
4445!
4446!-----------------------------------------------------------------------
4447! Initialize return code flag to success state (no error).
4448!-----------------------------------------------------------------------
4449!
4450 IF (esm_track) THEN
4451 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Export', &
4452 & ', PET', petrank
4453 FLUSH (trac)
4454 END IF
4455 rc=esmf_success
4456!
4457!-----------------------------------------------------------------------
4458! Get information about the gridded component.
4459!-----------------------------------------------------------------------
4460!
4461 CALL esmf_gridcompget (model, &
4462 & localpet=localpet, &
4463 & vm=vm, &
4464 & name=cname, &
4465 & rc=rc)
4466 IF (esmf_logfounderror(rctocheck=rc, &
4467 & msg=esmf_logerr_passthru, &
4468 & line=__line__, &
4469 & file=myfile)) THEN
4470 RETURN
4471 END IF
4472!
4473! Get number of local decomposition elements (DEs). Usually, a single
4474! DE is associated with each Persistent Execution Thread (PETs). Thus,
4475! localDEcount=1.
4476!
4477 CALL esmf_gridget (models(iroms)%grid(ng), &
4478 & localdecount=localdecount, &
4479 & rc=rc)
4480 IF (esmf_logfounderror(rctocheck=rc, &
4481 & msg=esmf_logerr_passthru, &
4482 & line=__line__, &
4483 & file=myfile)) THEN
4484 RETURN
4485 END IF
4486!
4487! Set horizontal tile bounds.
4488!
4489 tile=localpet
4490!
4491 lbi=bounds(ng)%LBi(tile) ! lower bound I-direction
4492 ubi=bounds(ng)%UBi(tile) ! upper bound I-direction
4493 lbj=bounds(ng)%LBj(tile) ! lower bound J-direction
4494 ubj=bounds(ng)%UBj(tile) ! upper bound J-direction
4495!
4496 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
4497 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
4498 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
4499 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
4500!
4501 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
4502 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
4503 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
4504 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
4505!
4506!-----------------------------------------------------------------------
4507! Get current time.
4508!-----------------------------------------------------------------------
4509!
4510 CALL esmf_clockget (clockinfo(iroms)%Clock, &
4511 & currtime=currenttime, &
4512 & rc=rc)
4513 IF (esmf_logfounderror(rctocheck=rc, &
4514 & msg=esmf_logerr_passthru, &
4515 & line=__line__, &
4516 & file=myfile)) THEN
4517 RETURN
4518 END IF
4519!
4520 CALL esmf_timeget (currenttime, &
4521 & yy=year, &
4522 & mm=month, &
4523 & dd=day, &
4524 & h =hour, &
4525 & m =minutes, &
4526 & s =seconds, &
4527 & sn=sn, &
4528 & sd=sd, &
4529 & timestring=time_currentstring, &
4530 & rc=rc)
4531 IF (esmf_logfounderror(rctocheck=rc, &
4532 & msg=esmf_logerr_passthru, &
4533 & line=__line__, &
4534 & file=myfile)) THEN
4535 RETURN
4536 END IF
4537 is=index(time_currentstring, 'T') ! remove 'T' in
4538 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
4539!
4540!-----------------------------------------------------------------------
4541! Get list of export fields.
4542!-----------------------------------------------------------------------
4543!
4544 CALL esmf_stateget (models(iroms)%ExportState(ng), &
4545 & itemcount=exportcount, &
4546 & rc=rc)
4547 IF (esmf_logfounderror(rctocheck=rc, &
4548 & msg=esmf_logerr_passthru, &
4549 & line=__line__, &
4550 & file=myfile)) THEN
4551 RETURN
4552 END IF
4553!
4554 IF (.not. allocated(exportnamelist)) THEN
4555 allocate ( exportnamelist(exportcount) )
4556 END IF
4557!
4558 CALL esmf_stateget (models(iroms)%ExportState(ng), &
4559 & itemnamelist=exportnamelist, &
4560 & rc=rc)
4561 IF (esmf_logfounderror(rctocheck=rc, &
4562 & msg=esmf_logerr_passthru, &
4563 & line=__line__, &
4564 & file=myfile)) THEN
4565 RETURN
4566 END IF
4567!
4568!-----------------------------------------------------------------------
4569! Load export fields.
4570!-----------------------------------------------------------------------
4571!
4572 get_barotropic=.true.
4573 get_surfacecurrent=.true.
4574!
4575 fld_loop : DO ifld=1,exportcount
4576!
4577! Get field from export state.
4578!
4579 CALL esmf_stateget (models(iroms)%ExportState(ng), &
4580 & trim(exportnamelist(ifld)), &
4581 & field, &
4582 & rc=rc)
4583 IF (esmf_logfounderror(rctocheck=rc, &
4584 & msg=esmf_logerr_passthru, &
4585 & line=__line__, &
4586 & file=myfile)) THEN
4587 RETURN
4588 END IF
4589!
4590! Get field pointer. Usually, the DO-loop is executed once since
4591! localDEcount=1.
4592!
4593 de_loop : DO localde=0,localdecount-1
4594 CALL esmf_fieldget (field, &
4595 & localde=localde, &
4596 & farrayptr=ptr2d, &
4597 & rc=rc)
4598 IF (esmf_logfounderror(rctocheck=rc, &
4599 & msg=esmf_logerr_passthru, &
4600 & line=__line__, &
4601 & file=myfile)) THEN
4602 RETURN
4603 END IF
4604!
4605! Initialize pointer to missing value.
4606!
4607 ptr2d=missing_dp
4608!
4609! Load field data into export state. Notice that all export fields
4610! are kept as computed by ROMS. The imported component does the
4611! proper scaling, physical units conversion, and other manipulations.
4612! It is done to avoid applying such transformations twice.
4613!
4614 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
4615!
4616! Sea surface temperature (C).
4617# if defined EXCLUDE_SPONGE && \
4618 (defined data_coupling && !defined ANA_SPONGE)
4619! If using a diffusion sponge, remove the SST points in the sponge area
4620! to supress the spurious influence of open boundary conditions in the
4621! computation of the net heat flux. The SST values in the sponge are
4622! from the large scale DATA component in the merged ocean/data field
4623! imported by the atmosphere model.
4624# endif
4625!
4626 CASE ('sst', 'SST')
4627 myfmin(1)= missing_dp
4628 myfmax(1)=-missing_dp
4629 DO j=jstrr,jendr
4630 DO i=istrr,iendr
4631# if defined EXCLUDE_SPONGE && \
4632 (defined data_coupling && !defined ANA_SPONGE)
4633 IF (ltracersponge(itemp,ng).and. &
4634 & mixing(ng)%diff_factor(i,j).gt.1.0_dp) THEN
4635 fval=missing_dp
4636 ELSE
4637 fval=ocean(ng)%t(i,j,n(ng),nstp(ng),itemp)
4638# ifdef MASKING
4639 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4640 myfmin(1)=min(myfmin(1),fval)
4641 myfmax(1)=max(myfmax(1),fval)
4642 END IF
4643# else
4644 myfmin(1)=min(myfmin(1),fval)
4645 myfmax(1)=max(myfmax(1),fval)
4646# endif
4647 END IF
4648# else
4649 fval=ocean(ng)%t(i,j,n(ng),nstp(ng),itemp)
4650# ifdef MASKING
4651 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4652 myfmin(1)=min(myfmin(1),fval)
4653 myfmax(1)=max(myfmax(1),fval)
4654 END IF
4655# else
4656 myfmin(1)=min(myfmin(1),fval)
4657 myfmax(1)=max(myfmax(1),fval)
4658# endif
4659# endif
4660 ptr2d(i,j)=fval
4661 END DO
4662 END DO
4663!
4664! Sea surface height (m).
4665!
4666 CASE ('ssh', 'SSH')
4667 myfmin(1)=1.0_dp
4668 myfmax(1)=0.0_dp
4669 DO j=jstrr,jendr
4670 DO i=istrr,iendr
4671 fval=ocean(ng)%zeta(i,j,knew(ng))
4672# ifdef MASKING
4673 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4674 myfmin(1)=min(myfmin(1),fval)
4675 myfmax(1)=max(myfmax(1),fval)
4676 END IF
4677# else
4678 myfmin(1)=min(myfmin(1),fval)
4679 myfmax(1)=max(myfmax(1),fval)
4680# endif
4681 ptr2d(i,j)=fval
4682 END DO
4683 END DO
4684!
4685! Depth-integrated (barotropic) currents (m/s) at interior RHO-points
4686! (East/North direction).
4687!
4688 CASE ('Ubar', 'Vbar')
4689 IF (founderror(assign_string(fldname, &
4690 & exportnamelist(ifld)), &
4691 & noerror, __line__, myfile)) THEN
4692 rc=esmf_rc_not_found
4693 RETURN
4694 END IF
4695!
4696 IF (get_barotropic) THEN
4697 get_barotropic=.false.
4698 IF (.not.allocated(ubar)) THEN
4699 allocate ( ubar(lbi:ubi,lbj:ubj) )
4700 ubar=missing_dp
4701 END IF
4702 IF (.not.allocated(vbar)) THEN
4703 allocate ( vbar(lbi:ubi,lbj:ubj) )
4704 vbar=missing_dp
4705 END IF
4706 CALL roms_rotate (ng, tile, grid2geo_rho, &
4707 & lbi, ubi, lbj, ubj, &
4708 & ocean(ng)%ubar(:,:,knew(ng)), &
4709 & ocean(ng)%vbar(:,:,knew(ng)), &
4710 & ubar, vbar)
4711 END IF
4712!
4713 IF (fldname.eq.'Ubar') THEN
4714 DO j=jstr,jend
4715 DO i=istr,iend
4716 fval=ubar(i,j)
4717 myfmin(1)=min(myfmin(1),fval)
4718 myfmax(1)=max(myfmax(1),fval)
4719 ptr2d(i,j)=fval
4720 END DO
4721 END DO
4722 deallocate (ubar)
4723 ELSE
4724 DO j=jstr,jend
4725 DO i=istr,iend
4726 fval=vbar(i,j)
4727 myfmin(1)=min(myfmin(1),fval)
4728 myfmax(1)=max(myfmax(1),fval)
4729 ptr2d(i,j)=fval
4730 END DO
4731 END DO
4732 deallocate (vbar)
4733 END IF
4734!
4735! Surface currents (m/s) at interior RHO-points (East/North direction).
4736!
4737 CASE ('Usur', 'Vsur')
4738 IF (founderror(assign_string(fldname, &
4739 & exportnamelist(ifld)), &
4740 & noerror, __line__, myfile)) THEN
4741 rc=esmf_rc_not_found
4742 RETURN
4743 END IF
4744!
4745 IF (get_surfacecurrent) THEN
4746 get_surfacecurrent=.false.
4747 IF (.not.allocated(ubar)) THEN
4748 allocate ( usur(lbi:ubi,lbj:ubj) )
4749 usur=missing_dp
4750 END IF
4751 IF (.not.allocated(vbar)) THEN
4752 allocate ( vsur(lbi:ubi,lbj:ubj) )
4753 vsur=missing_dp
4754 END IF
4755 CALL roms_rotate (ng, tile, grid2geo_rho, &
4756 & lbi, ubi, lbj, ubj, &
4757 & ocean(ng)%u(:,:,n(ng),nstp(ng)), &
4758 & ocean(ng)%v(:,:,n(ng),nstp(ng)), &
4759 & usur, vsur)
4760 END IF
4761!
4762 IF (fldname.eq.'Usur') THEN
4763 DO j=jstr,jend
4764 DO i=istr,iend
4765 fval=usur(i,j)
4766 myfmin(1)=min(myfmin(1),fval)
4767 myfmax(1)=max(myfmax(1),fval)
4768 ptr2d(i,j)=fval
4769 END DO
4770 END DO
4771 deallocate (usur)
4772 ELSE
4773 DO j=jstr,jend
4774 DO i=istr,iend
4775 fval=vsur(i,j)
4776 myfmin(1)=min(myfmin(1),fval)
4777 myfmax(1)=max(myfmax(1),fval)
4778 ptr2d(i,j)=fval
4779 END DO
4780 END DO
4781 deallocate (vsur)
4782 END IF
4783!
4784! Bathymetry (m). It can be time dependent due sediment morphology.
4785!
4786 CASE ('bath')
4787 myfmin(1)=1.0_dp
4788 myfmax(1)=0.0_dp
4789 DO j=jstrr,jendr
4790 DO i=istrr,iendr
4791 fval=grid(ng)%h(i,j)
4792 myfmin(1)=min(myfmin(1),fval)
4793 myfmax(1)=max(myfmax(1),fval)
4794 ptr2d(i,j)=fval
4795 END DO
4796 END DO
4797
4798# if defined MASKING
4799!
4800! Update wet point land/sea mask, if differs from static mask.
4801!
4802 CASE ('mask_rho', 'rmask', 'msk')
4803 myfmin(1)=1.0_dp
4804 myfmax(1)=0.0_dp
4805 DO j=jstrr,jendr
4806 DO i=istrr,iendr
4807 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4808# ifdef WET_DRY
4809 IF (grid(ng)%rmask(i,j).ne. &
4810 & grid(ng)%rmask_wet(i,j)) THEN
4811 ptr2d(i,j)=grid(ng)%rmask_wet(i,j)
4812 ELSE
4813 ptr2d(i,j)=grid(ng)%rmask(i,j)
4814 END IF
4815# else
4816 ptr2d(i,j)=grid(ng)%rmask(i,j)
4817# endif
4818 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4819 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4820 END IF
4821 END DO
4822 END DO
4823# endif
4824!
4825! Export field not found.
4826!
4827 CASE DEFAULT
4828 IF (localpet.eq.0) THEN
4829 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
4830 & trim(cinpname)
4831 END IF
4832 rc=esmf_rc_not_found
4833 IF (esmf_logfounderror(rctocheck=rc, &
4834 & msg=esmf_logerr_passthru, &
4835 & line=__line__, &
4836 & file=myfile)) THEN
4837 RETURN
4838 END IF
4839 END SELECT
4840!
4841! Nullify pointer to make sure that it does not point on a random
4842! part in the memory.
4843!
4844 IF (associated(ptr2d)) nullify (ptr2d)
4845 END DO de_loop
4846!
4847! Get export field minimun and maximum values.
4848!
4849 CALL esmf_vmallreduce (vm, &
4850 & senddata=myfmin, &
4851 & recvdata=fmin, &
4852 & count=1, &
4853 & reduceflag=esmf_reduce_min, &
4854 & rc=rc)
4855 IF (esmf_logfounderror(rctocheck=rc, &
4856 & msg=esmf_logerr_passthru, &
4857 & line=__line__, &
4858 & file=myfile)) THEN
4859 RETURN
4860 END IF
4861!
4862 CALL esmf_vmallreduce (vm, &
4863 & senddata=myfmax, &
4864 & recvdata=fmax, &
4865 & count=1, &
4866 & reduceflag=esmf_reduce_max, &
4867 & rc=rc)
4868 IF (esmf_logfounderror(rctocheck=rc, &
4869 & msg=esmf_logerr_passthru, &
4870 & line=__line__, &
4871 & file=myfile)) THEN
4872 RETURN
4873 END IF
4874!
4875 IF (localpet.eq.0) THEN
4876 WRITE (cplout,20) trim(exportnamelist(ifld)), &
4877 & trim(time_currentstring), ng, &
4878 & fmin(1), fmax(1)
4879 END IF
4880!
4881! Debugging: write out field into a NetCDF file.
4882!
4883 IF ((debuglevel.ge.3).and. &
4884 & models(iroms)%ExportField(ifld)%debug_write) THEN
4885 WRITE (ofile,30) ng, trim(exportnamelist(ifld)), &
4886 year, month, day, hour, minutes, seconds
4887 CALL esmf_fieldwrite (field, &
4888 & trim(ofile), &
4889 & overwrite=.true., &
4890 & rc=rc)
4891 IF (esmf_logfounderror(rctocheck=rc, &
4892 & msg=esmf_logerr_passthru, &
4893 & line=__line__, &
4894 & file=myfile)) THEN
4895 RETURN
4896 END IF
4897 END IF
4898 END DO fld_loop
4899!
4900! Deallocate local arrays.
4901!
4902 IF (allocated(exportnamelist)) deallocate (exportnamelist)
4903!
4904! Update ROMS export calls counter.
4905!
4906 IF (exportcount.gt.0) THEN
4907 models(iroms)%ExportCalls=models(iroms)%ExportCalls+1
4908 END IF
4909!
4910 IF (esm_track) THEN
4911 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Export', &
4912 & ', PET', petrank
4913 FLUSH (trac)
4914 END IF
4915 FLUSH (cplout)
4916!
4917 10 FORMAT (/,3x,' ROMS_Export - unable to find option to export: ', &
4918 & a,/,18x,'check ''Export(roms)'' in input script: ',a)
4919 20 FORMAT (3x,' ROMS_Export - ESMF: exporting field ''',a,'''', &
4920 & t72,a,2x,'Grid ',i2.2,/, &
4921 & 18x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
4922 & ')')
4923 30 FORMAT ('roms_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
4924 & i2.2,2('.',i2.2),'.nc')
4925
4926 RETURN

References strings_mod::assign_string(), mod_param::bounds, mod_esmf_esm::cinpname, mod_esmf_esm::clockinfo, mod_esmf_esm::cplout, mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, strings_mod::founderror(), mod_grid::grid, grid2geo_rho, mod_esmf_esm::iroms, mod_scalars::itemp, mod_stepping::knew, mod_scalars::ltracersponge, mod_esmf_esm::missing_dp, mod_mixing::mixing, mod_param::mm, mod_esmf_esm::models, mod_param::n, mod_scalars::noerror, mod_stepping::nstp, mod_ocean::ocean, mod_esmf_esm::petrank, roms_rotate(), and mod_esmf_esm::trac.

Referenced by roms_datainit(), and roms_modeladvance().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_import()

subroutine, private esmf_roms_mod::roms_import ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 2743 of file esmf_roms.h.

2744!
2745!=======================================================================
2746! !
2747! Imports fields into ROMS array structures. The fields aew loaded !
2748! into the snapshot storage arrays to allow time interpolation in !
2749! ROMS kernel. !
2750! !
2751!=======================================================================
2752!
2753! Imported variable declarations.
2754!
2755 integer, intent(in) :: ng
2756 integer, intent(out) :: rc
2757!
2758 TYPE (ESMF_GridComp) :: model
2759!
2760! Local variable declarations.
2761!
2762 logical :: LoadIt, isPresent
2763 logical :: got_stress(2), got_wind(2)
2764# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2765 logical :: got_RhoAir, got_Wstar, got_wind_sbl(2)
2766# endif
2767!
2768 integer :: Istr, Iend, Jstr, Jend
2769 integer :: IstrR, IendR, JstrR, JendR
2770 integer :: LBi, UBi, LBj, UBj
2771 integer :: ImportCount, Tindex
2772 integer :: localDE, localDEcount, localPET, tile
2773 integer :: year, month, day, hour, minutes, seconds, sN, SD
2774 integer :: gtype, id, ifield, ifld, i, is, j
2775!
2776# ifdef TIME_INTERP
2777 integer, save :: record = 0
2778!
2779# endif
2780 real (dp), parameter :: eps = 1.0e-10_dp
2781!
2782 real (dp) :: TimeInDays, Time_Current, Tmin, Tmax, Tstr, Tend
2783# ifdef TIME_INTERP
2784 real (dp) :: MyTimeInDays
2785# endif
2786 real (dp) :: Fseconds, ROMSclockTime
2787 real (dp) :: MyTintrp(2), MyVtime(2)
2788
2789 real (dp) :: MyFmax(2), MyFmin(2), Fmin(2), Fmax(2), Fval
2790 real (dp) :: add_offset, romsScale, scale, cff1, cff2, cff3
2791 real (dp) :: FreshWaterScale, StressScale, TracerFluxScale
2792# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2793 real (dp) :: Urel, Vrel, Wmag, Wrel
2794# endif
2795 real (dp) :: AttValues(14)
2796!
2797 real (dp), pointer :: ptr2d(:,:) => null()
2798!
2799# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2800 real (dp), allocatable :: RhoAir(:,:), Wstar(:,:)
2801 real (dp), allocatable :: Uwrk(:,:), Vwrk(:,:)
2802 real (dp), allocatable :: Xwind(:,:), Ywind(:,:)
2803# endif
2804 real (dp), allocatable :: Ustress(:,:), Vstress(:,:)
2805 real (dp), allocatable :: Uwind(:,:), Vwind(:,:)
2806!
2807 character (len=22) :: MyDate(2)
2808# ifdef TIME_INTERP
2809 character (len=22) :: MyDateString(1,1,1)
2810# endif
2811 character (len=22) :: Time_CurrentString
2812 character (len=40) :: AttName
2813
2814 character (len=*), parameter :: MyFile = &
2815 & __FILE__//", ROMS_Import"
2816
2817 character (ESMF_MAXSTR) :: cname, ofile
2818 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
2819!
2820 TYPE (ESMF_AttPack) :: AttPack
2821 TYPE (ESMF_Clock) :: clock
2822 TYPE (ESMF_Field) :: field
2823 TYPE (ESMF_Time) :: CurrentTime
2824 TYPE (ESMF_VM) :: vm
2825
2826# ifdef TIME_INTERP
2827!
2828 sourcefile=myfile
2829# endif
2830!
2831!-----------------------------------------------------------------------
2832! Initialize return code flag to success state (no error).
2833!-----------------------------------------------------------------------
2834!
2835 IF (esm_track) THEN
2836 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Import', &
2837 & ', PET', petrank
2838 FLUSH (trac)
2839 END IF
2840 rc=esmf_success
2841!
2842!-----------------------------------------------------------------------
2843! Get information about the gridded component.
2844!-----------------------------------------------------------------------
2845!
2846 CALL esmf_gridcompget (model, &
2847 & clock=clock, &
2848 & localpet=localpet, &
2849 & vm=vm, &
2850 & name=cname, &
2851 & rc=rc)
2852 IF (esmf_logfounderror(rctocheck=rc, &
2853 & msg=esmf_logerr_passthru, &
2854 & line=__line__, &
2855 & file=myfile)) THEN
2856 RETURN
2857 END IF
2858!
2859! Get number of local decomposition elements (DEs). Usually, a single
2860! DE is associated with each Persistent Execution Thread (PETs). Thus,
2861! localDEcount=1.
2862!
2863 CALL esmf_gridget (models(iroms)%grid(ng), &
2864 & localdecount=localdecount, &
2865 & rc=rc)
2866 IF (esmf_logfounderror(rctocheck=rc, &
2867 & msg=esmf_logerr_passthru, &
2868 & line=__line__, &
2869 & file=myfile)) THEN
2870 RETURN
2871 END IF
2872!
2873! Set size of imported tiled-arrays.
2874!
2875 tile=localpet
2876!
2877 lbi=bounds(ng)%LBi(tile) ! lower bound I-direction
2878 ubi=bounds(ng)%UBi(tile) ! upper bound I-direction
2879 lbj=bounds(ng)%LBj(tile) ! lower bound J-direction
2880 ubj=bounds(ng)%UBj(tile) ! upper bound J-direction
2881!
2882 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
2883 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
2884 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
2885 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
2886!
2887 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
2888 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
2889 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
2890 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
2891!
2892!-----------------------------------------------------------------------
2893! Get current time.
2894!-----------------------------------------------------------------------
2895!
2896 CALL esmf_clockget (clock, &
2897 & currtime=currenttime, &
2898 & rc=rc)
2899 IF (esmf_logfounderror(rctocheck=rc, &
2900 & msg=esmf_logerr_passthru, &
2901 & line=__line__, &
2902 & file=myfile)) THEN
2903 RETURN
2904 END IF
2905!
2906 CALL esmf_timeget (currenttime, &
2907 & yy=year, &
2908 & mm=month, &
2909 & dd=day, &
2910 & h =hour, &
2911 & m =minutes, &
2912 & s =seconds, &
2913 & sn=sn, &
2914 & sd=sd, &
2915 & rc=rc)
2916 IF (esmf_logfounderror(rctocheck=rc, &
2917 & msg=esmf_logerr_passthru, &
2918 & line=__line__, &
2919 & file=myfile)) THEN
2920 RETURN
2921 END IF
2922!
2923 CALL esmf_timeget (currenttime, &
2924 & s_r8=time_current, &
2925 & timestring=time_currentstring, &
2926 & rc=rc)
2927 IF (esmf_logfounderror(rctocheck=rc, &
2928 & msg=esmf_logerr_passthru, &
2929 & line=__line__, &
2930 & file=myfile)) THEN
2931 RETURN
2932 END IF
2933 timeindays=time_current/86400.0_dp
2934 is=index(time_currentstring, 'T') ! remove 'T' in
2935 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2936!
2937!-----------------------------------------------------------------------
2938! Convert CurrentTime into ROMS clock ellapsed time since
2939! initialization in seconds from reference time.
2940! (The routine "ROMS_clock" is located in ROMS/Utility/dateclock.F)
2941!-----------------------------------------------------------------------
2942!
2943 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
2944 CALL roms_clock (year, month, day, hour, minutes, fseconds, &
2945 & romsclocktime)
2946!
2947!-----------------------------------------------------------------------
2948! Get list of import fields.
2949!-----------------------------------------------------------------------
2950!
2951 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2952 & itemcount=importcount, &
2953 & rc=rc)
2954 IF (esmf_logfounderror(rctocheck=rc, &
2955 & msg=esmf_logerr_passthru, &
2956 & line=__line__, &
2957 & file=myfile)) THEN
2958 RETURN
2959 END IF
2960!
2961 IF (.not.allocated(importnamelist)) THEN
2962 allocate ( importnamelist(importcount) )
2963 END IF
2964 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2965 & itemnamelist=importnamelist, &
2966 & rc=rc)
2967 IF (esmf_logfounderror(rctocheck=rc, &
2968 & msg=esmf_logerr_passthru, &
2969 & line=__line__, &
2970 & file=myfile)) THEN
2971 RETURN
2972 END IF
2973
2974# ifdef TIME_INTERP
2975!
2976!-----------------------------------------------------------------------
2977! Advance unlimited dimension counter.
2978!-----------------------------------------------------------------------
2979!
2980 IF (petlayoutoption.eq.'CONCURRENT') THEN
2981 record=record+1
2982 END IF
2983# endif
2984!
2985!-----------------------------------------------------------------------
2986! Get import fields.
2987!-----------------------------------------------------------------------
2988!
2989! Set switches to rotate wind stress and wind component for curvilinear
2990! ROMS grid applications.
2991!
2992 got_stress(1:2)=.false.
2993 got_wind(1:2)=.false.
2994# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2995 got_rhoair=.false.
2996 got_wstar=.false.
2997 got_wind_sbl(1:2)=.false.
2998# endif
2999!
3000! Loop over all import fields to process.
3001!
3002 fld_loop : DO ifld=1,importcount
3003 id=field_index(models(iroms)%ImportField, importnamelist(ifld))
3004!
3005! Get field from import state.
3006!
3007 CALL esmf_stateget (models(iroms)%ImportState(ng), &
3008 & trim(importnamelist(ifld)), &
3009 & field, &
3010 & rc=rc)
3011 IF (esmf_logfounderror(rctocheck=rc, &
3012 & msg=esmf_logerr_passthru, &
3013 & line=__line__, &
3014 & file=myfile)) THEN
3015 RETURN
3016 END IF
3017
3018# ifdef TIME_INTERP
3019!
3020! If cuncurrent coupling and importing time snapshots, update values
3021! in the MODELS(Iroms)%ImportField structure by reading import field
3022! interpolation attributes from source NetCDF file. It is very tricky
3023! to perform inter VM communications. It is easier to read them from
3024! a NetCDF file. ROMS needs these attributes to perform the time
3025! interpolation between snapshots in its kernel.
3026! (HGA: need to figure out how to do inter VM communications)
3027!
3028 IF (petlayoutoption.eq.'CONCURRENT') THEN
3029 CALL netcdf_get_ivar (ng, inlm, attfilename, 'Tindex', &
3030 & models(iroms)%ImportField(id)%Tindex, &
3031 & start=(/iroms,id,record/), &
3032 & total=(/1,1,1/))
3033 IF (founderror(exit_flag, noerror, __line__, &
3034 & myfile)) THEN
3035 rc=esmf_rc_file_read
3036 RETURN
3037 END IF
3038!
3039 is=models(iroms)%ImportField(id)%Tindex
3040 CALL netcdf_get_svar (ng, inlm, attfilename, 'Date', &
3041 & mydatestring, &
3042 & start=(/1,iroms,id,record/), &
3043 & total=(/22,1,1,1/))
3044 IF (founderror(exit_flag, noerror, __line__, &
3045 & myfile)) THEN
3046 rc=esmf_rc_file_read
3047 RETURN
3048 END IF
3049 models(iroms)%ImportField(id)%DateString(is)= &
3050 & mydatestring(1,1,1)
3051!
3052 CALL netcdf_get_time (ng, inlm, attfilename, 'Tcurrent', &
3053 & rclock%DateNumber, mytimeindays, &
3054 & start=(/iroms,id,record/), &
3055 & total=(/1,1,1/))
3056 IF (founderror(exit_flag, noerror, __line__, &
3057 & myfile)) THEN
3058 rc=esmf_rc_file_read
3059 RETURN
3060 END IF
3061!
3062 CALL netcdf_get_time (ng, inlm, attfilename, 'Tstr', &
3063 & rclock%DateNumber, &
3064 & models(iroms)%ImportField(id)%Tstr, &
3065 & start=(/iroms,id,record/), &
3066 & total=(/1,1,1/))
3067 IF (founderror(exit_flag, noerror, __line__, &
3068 & myfile)) THEN
3069 rc=esmf_rc_file_read
3070 RETURN
3071 END IF
3072!
3073 CALL netcdf_get_time (ng, inlm, attfilename, 'Tend', &
3074 & rclock%DateNumber, &
3075 & models(iroms)%ImportField(id)%Tend, &
3076 & start=(/iroms,id,record/), &
3077 & total=(/1,1,1/))
3078 IF (founderror(exit_flag, noerror, __line__, &
3079 & myfile)) THEN
3080 rc=esmf_rc_file_read
3081 RETURN
3082 END IF
3083!
3084 CALL netcdf_get_time (ng, inlm, attfilename, 'Tintrp', &
3085 & rclock%DateNumber, &
3086 & models(iroms)%ImportField(id)%Tintrp(is), &
3087 & start=(/iroms,id,record/), &
3088 & total=(/1,1,1/))
3089 IF (founderror(exit_flag, noerror, __line__, &
3090 & myfile)) THEN
3091 rc=esmf_rc_file_read
3092 RETURN
3093 END IF
3094!
3095 CALL netcdf_get_time (ng, inlm, attfilename, 'Vtime', &
3096 & rclock%DateNumber, &
3097 & models(iroms)%ImportField(id)%Vtime(is), &
3098 & start=(/iroms,id,record/), &
3099 & total=(/1,1,1/))
3100 IF (founderror(exit_flag, noerror, __line__, &
3101 & myfile)) THEN
3102 rc=esmf_rc_file_read
3103 RETURN
3104 END IF
3105 CALL netcdf_get_time (ng, inlm, attfilename, 'Tmin', &
3106 & rclock%DateNumber, &
3107 & models(iroms)%ImportField(id)%Tmin, &
3108 & start=(/iroms,id,record/), &
3109 & total=(/1,1,1/))
3110 IF (founderror(exit_flag, noerror, __line__, &
3111 & myfile)) THEN
3112 rc=esmf_rc_file_read
3113 RETURN
3114 END IF
3115!
3116 CALL netcdf_get_time (ng, inlm, attfilename, 'Tmax', &
3117 & rclock%DateNumber, &
3118 & models(iroms)%ImportField(id)%Tmax, &
3119 & start=(/iroms,id,record/), &
3120 & total=(/1,1,1/))
3121 IF (founderror(exit_flag, noerror, __line__, &
3122 & myfile)) THEN
3123 rc=esmf_rc_file_read
3124 RETURN
3125 END IF
3126 END IF
3127# endif
3128!
3129! Get field pointer. Usually, the DO-loop is executed once since
3130! localDEcount=1.
3131!
3132 de_loop : DO localde=0,localdecount-1
3133 CALL esmf_fieldget (field, &
3134 & localde=localde, &
3135 & farrayptr=ptr2d, &
3136 & rc=rc)
3137 IF (esmf_logfounderror(rctocheck=rc, &
3138 & msg=esmf_logerr_passthru, &
3139 & line=__line__, &
3140 & file=myfile)) THEN
3141 RETURN
3142 END IF
3143
3144# ifdef TIME_INTERP_NOT_WORKING
3145!
3146! Retrieve custom Attribute Package.
3147!
3148 CALL esmf_attributegetattpack (field, &
3149 & 'CustomConvention', &
3150 & 'General', &
3151!! & 'Instance', &
3152 & attpack=attpack, &
3153 & ispresent=ispresent, &
3154 & rc=rc)
3155 IF (esmf_logfounderror(rctocheck=rc, &
3156 & msg=esmf_logerr_passthru, &
3157 & line=__line__, &
3158 & file=myfile)) THEN
3159 RETURN
3160 END IF
3161!
3162! Get field custom attribute for field for time interpolation.
3163!
3164 CALL esmf_attributeget (field, &
3165 & name='TimeInterp', &
3166 & valuelist=attvalues, &
3167 & attpack=attpack, &
3168 & ispresent=ispresent, &
3169 & rc=rc)
3170 IF (esmf_logfounderror(rctocheck=rc, &
3171 & msg=esmf_logerr_passthru, &
3172 & line=__line__, &
3173 & file=myfile)) THEN
3174 RETURN
3175 END IF
3176# endif
3177!
3178! Load import data into ROMS component variable.
3179# ifdef TIME_INTERP
3180! If time interpolating in ROMS kernel, loaded import data into
3181! snapshot storage arrays so time interpolating is carry out.
3182! It is a generic strategy for the case that coupling interval
3183! is greater than ROMS time-step size. Usually, time persisting
3184! of coupling data may alter ocean solution. For example, it may
3185! affect the ocean circulation/energetics if atmospheric forcing
3186! is persisted during infrequent coupling (like every 3, 6, or
3187! 24 hours and so on).
3188# endif
3189!
3190 loadit=.true.
3191 scale =models(iroms)%ImportField(id)%scale_factor
3192 add_offset =models(iroms)%ImportField(id)%add_offset
3193 tindex =models(iroms)%ImportField(id)%Tindex
3194# ifdef TIME_INTERP
3195 tmin =models(iroms)%ImportField(id)%Tmin
3196 tmax =models(iroms)%ImportField(id)%Tmax
3197 tstr =models(iroms)%ImportField(id)%Tstr
3198 tend =models(iroms)%ImportField(id)%Tend
3199 mytintrp(1)=models(iroms)%ImportField(id)%Tintrp(1)
3200 mytintrp(2)=models(iroms)%ImportField(id)%Tintrp(2)
3201 myvtime(1) =models(iroms)%ImportField(id)%Vtime(1)
3202 myvtime(2) =models(iroms)%ImportField(id)%Vtime(2)
3203 mydate(1) =models(iroms)%ImportField(id)%DateString(1)
3204 mydate(2) =models(iroms)%ImportField(id)%DateString(2)
3205# endif
3206!
3207! Set ROMS momentum fluxes and tracer flux scales to kinematic values.
3208! Recall, that all the fluxes are kinematic.
3209!
3210 freshwaterscale=1.0_dp/rho0 ! Kg m-2 s-1 to m/s
3211 stressscale=1.0_dp/rho0 ! Pa=N m-2 to m2/s2
3212 tracerfluxscale=1.0_dp/(rho0*cp) ! Watts m-2 to C m/s
3213!
3214 fval=ptr2d(istrr,jstrr)
3215 myfmin(1)= missing_dp
3216 myfmax(1)=-missing_dp
3217 myfmin(2)= missing_dp
3218 myfmax(2)=-missing_dp
3219!
3220 SELECT CASE (trim(adjustl(importnamelist(ifld))))
3221
3222# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
3223!
3224! Surface air pressure or mean sea level pressure (mb).
3225!
3226 CASE ('psfc', 'Pair', 'Pmsl')
3227 romsscale=scale
3228 ifield=idpair
3229 gtype=r2dvar
3230 tindex=3-iinfo(8,ifield,ng)
3231 DO j=jstrr,jendr
3232 DO i=istrr,iendr
3233 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3234 fval=scale*ptr2d(i,j)+add_offset
3235 ELSE
3236 fval=0.0_dp
3237 END IF
3238 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3239 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3240 myfmin(2)=min(myfmin(2),fval)
3241 myfmax(2)=max(myfmax(2),fval)
3242# ifdef TIME_INTERP
3243 forces(ng)%PairG(i,j,tindex)=fval
3244# else
3245 forces(ng)%Pair(i,j)=fval
3246# endif
3247 END DO
3248 END DO
3249# ifndef TIME_INTERP
3250 IF (localde.eq.localdecount-1) THEN
3251 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3252 CALL exchange_r2d_tile (ng, tile, &
3253 & lbi, ubi, lbj, ubj, &
3254 & forces(ng)%Pair)
3255 END IF
3256 CALL mp_exchange2d (ng, tile, inlm, 1, &
3257 & lbi, ubi, lbj, ubj, &
3258 & nghostpoints, &
3259 & ewperiodic(ng), nsperiodic(ng), &
3260 & forces(ng)%Pair)
3261 END IF
3262# endif
3263# endif
3264# if defined BULK_FLUXES || defined ECOSIM || \
3265 (defined shortwave && defined ana_srflux && defined albedo)
3266!
3267! Surface air temperature (Celsius).
3268!
3269 CASE ('tsfc', 'Tair')
3270 romsscale=scale
3271 ifield=idtair
3272 gtype=r2dvar
3273 tindex=3-iinfo(8,ifield,ng)
3274 DO j=jstrr,jendr
3275 DO i=istrr,iendr
3276 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3277 fval=scale*ptr2d(i,j)+add_offset
3278 ELSE
3279 fval=0.0_dp
3280 END IF
3281 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3282 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3283 myfmin(2)=min(myfmin(2),fval)
3284 myfmax(2)=max(myfmax(2),fval)
3285# ifdef TIME_INTERP
3286 forces(ng)%TairG(i,j,tindex)=fval
3287# else
3288 forces(ng)%Tair(i,j)=fval
3289# endif
3290 END DO
3291 END DO
3292# ifndef TIME_INTERP
3293 IF (localde.eq.localdecount-1) THEN
3294 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3295 CALL exchange_r2d_tile (ng, tile, &
3296 & lbi, ubi, lbj, ubj, &
3297 & forces(ng)%Tair)
3298 END IF
3299 CALL mp_exchange2d (ng, tile, inlm, 1, &
3300 & lbi, ubi, lbj, ubj, &
3301 & nghostpoints, &
3302 & ewperiodic(ng), nsperiodic(ng), &
3303 & forces(ng)%Tair)
3304 END IF
3305# endif
3306# endif
3307# if defined BULK_FLUXES || defined ECOSIM
3308!
3309! Surface air relative humidity (percentage). Notice that as the
3310! specific humidity, it is loaded to FORCES(ng)%Hair and "bulk_flux.F"
3311! will compute the specific humidity (kg/kg).
3312!
3313 CASE ('Qair')
3314 romsscale=scale
3315 ifield=idqair
3316 gtype=r2dvar
3317 tindex=3-iinfo(8,ifield,ng)
3318 DO j=jstrr,jendr
3319 DO i=istrr,iendr
3320 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3321 fval=scale*ptr2d(i,j)+add_offset
3322 ELSE
3323 fval=0.0_dp
3324 END IF
3325 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3326 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3327 myfmin(2)=min(myfmin(2),fval)
3328 myfmax(2)=max(myfmax(2),fval)
3329# ifdef TIME_INTERP
3330 forces(ng)%HairG(i,j,tindex)=fval
3331# else
3332 forces(ng)%Hair(i,j)=fval
3333# endif
3334 END DO
3335 END DO
3336# ifndef TIME_INTERP
3337 IF (localde.eq.localdecount-1) THEN
3338 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3339 CALL exchange_r2d_tile (ng, tile, &
3340 & lbi, ubi, lbj, ubj, &
3341 & forces(ng)%Hair)
3342 END IF
3343 CALL mp_exchange2d (ng, tile, inlm, 1, &
3344 & lbi, ubi, lbj, ubj, &
3345 & nghostpoints, &
3346 & ewperiodic(ng), nsperiodic(ng), &
3347 & forces(ng)%Hair)
3348 END IF
3349# endif
3350# endif
3351# if defined BULK_FLUXES
3352!
3353! Surface air specific humidity (kg kg-1).
3354!
3355 CASE ('Hair', 'qsfc')
3356 romsscale=scale
3357 ifield=idqair
3358 gtype=r2dvar
3359 tindex=3-iinfo(8,ifield,ng)
3360 DO j=jstrr,jendr
3361 DO i=istrr,iendr
3362 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3363 fval=scale*ptr2d(i,j)+add_offset
3364 ELSE
3365 fval=0.0_dp
3366 END IF
3367 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3368 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3369 myfmin(2)=min(myfmin(2),fval)
3370 myfmax(2)=max(myfmax(2),fval)
3371# ifdef TIME_INTERP
3372 forces(ng)%HairG(i,j,tindex)=fval
3373# else
3374 forces(ng)%Hair(i,j)=fval
3375# endif
3376 END DO
3377 END DO
3378# ifndef TIME_INTERP
3379 IF (localde.eq.localdecount-1) THEN
3380 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3381 CALL exchange_r2d_tile (ng, tile, &
3382 & lbi, ubi, lbj, ubj, &
3383 & forces(ng)%Hair)
3384 END IF
3385 CALL mp_exchange2d (ng, tile, inlm, 1, &
3386 & lbi, ubi, lbj, ubj, &
3387 & nghostpoints, &
3388 & ewperiodic(ng), nsperiodic(ng), &
3389 & forces(ng)%Hair)
3390 END IF
3391# endif
3392# endif
3393# if defined BULK_FLUXES
3394!
3395! Surface net longwave radiation (Celcius m s-1).
3396!
3397 CASE ('lwrd', 'LWrad')
3398 romsscale=tracerfluxscale
3399 ifield=idlrad
3400 gtype=r2dvar
3401 tindex=3-iinfo(8,ifield,ng)
3402 DO j=jstrr,jendr
3403 DO i=istrr,iendr
3404 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3405 fval=scale*ptr2d(i,j)+add_offset
3406 ELSE
3407 fval=0.0_dp
3408 END IF
3409 myfmin(1)=min(myfmin(1),fval)
3410 myfmax(1)=max(myfmax(1),fval)
3411 fval=fval*romsscale
3412 myfmin(2)=min(myfmin(2),fval)
3413 myfmax(2)=max(myfmax(2),fval)
3414# ifdef TIME_INTERP
3415 forces(ng)%lrflxG(i,j,tindex)=fval
3416# else
3417 forces(ng)%lrflx(i,j)=fval
3418# endif
3419 END DO
3420 END DO
3421# ifndef TIME_INTERP
3422 IF (localde.eq.localdecount-1) THEN
3423 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3424 CALL exchange_r2d_tile (ng, tile, &
3425 & lbi, ubi, lbj, ubj, &
3426 & forces(ng)%lrflx)
3427 END IF
3428 CALL mp_exchange2d (ng, tile, inlm, 1, &
3429 & lbi, ubi, lbj, ubj, &
3430 & nghostpoints, &
3431 & ewperiodic(ng), nsperiodic(ng), &
3432 & forces(ng)%lrflx)
3433 END IF
3434# endif
3435# endif
3436# if defined BULK_FLUXES && defined LONGWAVE_OUT
3437!
3438! Surface downward longwave radiation (Celcius m s-1). ROMS will
3439! substract the outgoing IR from model sea surface temperature.
3440!
3441 CASE ('dlwr', 'dLWrad', 'lwrad_down')
3442 romsscale=tracerfluxscale
3443 ifield=idldwn
3444 gtype=r2dvar
3445 tindex=3-iinfo(8,ifield,ng)
3446 DO j=jstrr,jendr
3447 DO i=istrr,iendr
3448 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3449 fval=scale*ptr2d(i,j)+add_offset
3450 ELSE
3451 fval=0.0_dp
3452 END IF
3453 myfmin(1)=min(myfmin(1),fval)
3454 myfmax(1)=max(myfmax(1),fval)
3455 fval=fval*romsscale
3456 myfmin(2)=min(myfmin(2),fval)
3457 myfmax(2)=max(myfmax(2),fval)
3458# ifdef TIME_INTERP
3459 forces(ng)%lrflxG(i,j,tindex)=fval
3460# else
3461 forces(ng)%lrflx(i,j)=fval
3462# endif
3463 END DO
3464 END DO
3465# ifndef TIME_INTERP
3466 IF (localde.eq.localdecount-1) THEN
3467 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3468 CALL exchange_r2d_tile (ng, tile, &
3469 & lbi, ubi, lbj, ubj, &
3470 & forces(ng)%lrflx)
3471 END IF
3472 CALL mp_exchange2d (ng, tile, inlm, 1, &
3473 & lbi, ubi, lbj, ubj, &
3474 & nghostpoints, &
3475 & ewperiodic(ng), nsperiodic(ng), &
3476 & forces(ng)%lrflx)
3477 END IF
3478# endif
3479# endif
3480# if defined BULK_FLUXES
3481!
3482! Rain fall rate (kg m-2 s-1).
3483!
3484 CASE ('prec', 'rain')
3485 romsscale=scale
3486 ifield=idrain
3487 gtype=r2dvar
3488 tindex=3-iinfo(8,ifield,ng)
3489 DO j=jstrr,jendr
3490 DO i=istrr,iendr
3491 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3492 fval=scale*ptr2d(i,j)+add_offset
3493 ELSE
3494 fval=0.0_dp
3495 END IF
3496 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3497 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3498 myfmin(2)=min(myfmin(2),fval)
3499 myfmax(2)=max(myfmax(2),fval)
3500# ifdef TIME_INTERP
3501 forces(ng)%rainG(i,j,tindex)=fval
3502# else
3503 forces(ng)%rain(i,j)=fval
3504# endif
3505 END DO
3506 END DO
3507# ifndef TIME_INTERP
3508 IF (localde.eq.localdecount-1) THEN
3509 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3510 CALL exchange_r2d_tile (ng, tile, &
3511 & lbi, ubi, lbj, ubj, &
3512 & forces(ng)%rain)
3513 END IF
3514 CALL mp_exchange2d (ng, tile, inlm, 1, &
3515 & lbi, ubi, lbj, ubj, &
3516 & nghostpoints, &
3517 & ewperiodic(ng), nsperiodic(ng), &
3518 & forces(ng)%rain)
3519 END IF
3520# endif
3521# endif
3522# if defined BULK_FLUXES || defined ECOSIM
3523!
3524! Surface eastward wind component (m s-1). Imported wind component
3525! is at RHO-points.
3526!
3527 CASE ('wndu', 'Uwind')
3528 IF (.not.allocated(uwind)) THEN
3529 allocate ( uwind(lbi:ubi,lbj:ubj) )
3530 uwind=missing_dp
3531 END IF
3532 got_wind(1)=.true.
3533 romsscale=scale
3534 ifield=iduair
3535 gtype=r2dvar
3536 tindex=3-iinfo(8,ifield,ng)
3537 DO j=jstrr,jendr
3538 DO i=istrr,iendr
3539 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3540 fval=scale*ptr2d(i,j)+add_offset
3541 ELSE
3542 fval=0.0_dp
3543 END IF
3544 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3545 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3546 myfmin(2)=min(myfmin(2),fval)
3547 myfmax(2)=max(myfmax(2),fval)
3548# ifdef TIME_INTERP
3549 forces(ng)%UwindG(i,j,tindex)=fval
3550# else
3551 uwind(i,j)=fval
3552# endif
3553 END DO
3554 END DO
3555# ifndef TIME_INTERP
3556 IF (localde.eq.localdecount-1) THEN
3557 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3558 CALL exchange_r2d_tile (ng, tile, &
3559 & lbi, ubi, lbj, ubj, &
3560 & uwind)
3561 END IF
3562 CALL mp_exchange2d (ng, tile, inlm, 1, &
3563 & lbi, ubi, lbj, ubj, &
3564 & nghostpoints, &
3565 & ewperiodic(ng), nsperiodic(ng), &
3566 & uwind)
3567 END IF
3568# endif
3569# endif
3570# if defined BULK_FLUXES || defined ECOSIM
3571!
3572! Surface northward wind component (m s-1). Imported wind component
3573! is at RHO-points.
3574!
3575 CASE ('wndv', 'Vwind')
3576 IF (.not.allocated(vwind)) THEN
3577 allocate ( vwind(lbi:ubi,lbj:ubj) )
3578 vwind=missing_dp
3579 END IF
3580 got_wind(2)=.true.
3581 romsscale=scale
3582 ifield=idvair
3583 gtype=r2dvar
3584 tindex=3-iinfo(8,ifield,ng)
3585 DO j=jstrr,jendr
3586 DO i=istrr,iendr
3587 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3588 fval=scale*ptr2d(i,j)+add_offset
3589 ELSE
3590 fval=0.0_dp
3591 END IF
3592 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3593 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3594 myfmin(2)=min(myfmin(2),fval)
3595 myfmax(2)=max(myfmax(2),fval)
3596# ifdef TIME_INTERP
3597 forces(ng)%VwindG(i,j,tindex)=fval
3598# else
3599 vwind(i,j)=fval
3600# endif
3601 END DO
3602 END DO
3603# ifndef TIME_INTERP
3604 IF (localde.eq.localdecount-1) THEN
3605 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3606 CALL exchange_r2d_tile (ng, tile, &
3607 & lbi, ubi, lbj, ubj, &
3608 & vwind)
3609 END IF
3610 CALL mp_exchange2d (ng, tile, inlm, 1, &
3611 & lbi, ubi, lbj, ubj, &
3612 & nghostpoints, &
3613 & ewperiodic(ng), nsperiodic(ng), &
3614 & vwind)
3615 END IF
3616# endif
3617# endif
3618# if defined SHORTWAVE
3619!
3620! Surface solar shortwave radiation (Celsius m s-1).
3621!
3622 CASE ('swrd', 'swrad', 'SWrad', 'SWrad_daily')
3623 romsscale=tracerfluxscale
3624 ifield=idsrad
3625 gtype=r2dvar
3626 tindex=3-iinfo(8,ifield,ng)
3627 DO j=jstrr,jendr
3628 DO i=istrr,iendr
3629 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3630 fval=scale*ptr2d(i,j)+add_offset
3631 ELSE
3632 fval=0.0_dp
3633 END IF
3634 myfmin(1)=min(myfmin(1),fval)
3635 myfmax(1)=max(myfmax(1),fval)
3636 fval=fval*romsscale
3637 myfmin(2)=min(myfmin(2),fval)
3638 myfmax(2)=max(myfmax(2),fval)
3639# ifdef TIME_INTERP
3640 forces(ng)%srflxG(i,j,tindex)=fval
3641# else
3642 forces(ng)%srflx(i,j)=fval
3643# endif
3644 END DO
3645 END DO
3646# ifndef TIME_INTERP
3647 IF (localde.eq.localdecount-1) THEN
3648 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3649 CALL exchange_r2d_tile (ng, tile, &
3650 & lbi, ubi, lbj, ubj, &
3651 & forces(ng)%srflx)
3652 END IF
3653 CALL mp_exchange2d (ng, tile, inlm, 1, &
3654 & lbi, ubi, lbj, ubj, &
3655 & nghostpoints, &
3656 & ewperiodic(ng), nsperiodic(ng), &
3657 & forces(ng)%srflx)
3658 END IF
3659# endif
3660# endif
3661# if !defined BULK_FLUXES
3662!
3663! Net longwave radiation flux(W m-2). Used for debugging and plotting
3664! purposes to check the fluxes used for the computation of the surface
3665! net heat flux in NUOPC cap file "esmf_atm.F".
3666!
3667 CASE ('lwr', 'LWrad')
3668 romsscale=tracerfluxscale
3669 ifield=idlrad
3670 gtype=r2dvar
3671 tindex=3-iinfo(8,ifield,ng)
3672 DO j=jstrr,jendr
3673 DO i=istrr,iendr
3674 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3675 fval=scale*ptr2d(i,j)+add_offset
3676 ELSE
3677 fval=0.0_dp
3678 END IF
3679 myfmin(1)=min(myfmin(1),fval)
3680 myfmax(1)=max(myfmax(1),fval)
3681 fval=fval*romsscale
3682 myfmin(2)=min(myfmin(2),fval)
3683 myfmax(2)=max(myfmax(2),fval)
3684 forces(ng)%lrflx(i,j)=fval
3685 END DO
3686 END DO
3687!
3688! Surface downward longwave radiation flux(W m-2). Used for debugging
3689! and plotting purposes to check the fluxes used for the computation
3690! of the surface net heat flux in NUOPC cap file "esmf_atm.F".
3691!
3692 CASE ('dlwr', 'dLWrad', 'lwrad_down')
3693 romsscale=tracerfluxscale
3694 ifield=idldwn
3695 gtype=r2dvar
3696 tindex=3-iinfo(8,ifield,ng)
3697 DO j=jstrr,jendr
3698 DO i=istrr,iendr
3699 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3700 fval=scale*ptr2d(i,j)+add_offset
3701 ELSE
3702 fval=0.0_dp
3703 END IF
3704 myfmin(1)=min(myfmin(1),fval)
3705 myfmax(1)=max(myfmax(1),fval)
3706 fval=fval*romsscale
3707 myfmin(2)=min(myfmin(2),fval)
3708 myfmax(2)=max(myfmax(2),fval)
3709 forces(ng)%lrflx(i,j)=fval
3710 END DO
3711 END DO
3712!
3713! Surface latent heat flux (W m-2). Used for plotting and debugging
3714! purposes (DebugLevel=3) to check the components of the net surface
3715! net heat flux computation.
3716!
3717 CASE ('latent', 'LHfx')
3718 romsscale=tracerfluxscale
3719 gtype=r2dvar
3720 DO j=jstrr,jendr
3721 DO i=istrr,iendr
3722 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3723 fval=scale*ptr2d(i,j)+add_offset
3724 ELSE
3725 fval=0.0_dp
3726 END IF
3727 myfmin(1)=min(myfmin(1),fval)
3728 myfmax(1)=max(myfmax(1),fval)
3729 fval=fval*romsscale
3730 myfmin(2)=min(myfmin(2),fval)
3731 myfmax(2)=max(myfmax(2),fval)
3732 forces(ng)%lhflx(i,j)=fval
3733 END DO
3734 END DO
3735!
3736! Surface sensible heat flux (W m-2). Used for plotting and debugging
3737! purposes (DebugLevel=3) to check the components of the net surface
3738! net heat flux computation.
3739!
3740 CASE ('sensible', 'SHfx')
3741 romsscale=tracerfluxscale
3742 gtype=r2dvar
3743 DO j=jstrr,jendr
3744 DO i=istrr,iendr
3745 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3746 fval=scale*ptr2d(i,j)+add_offset
3747 ELSE
3748 fval=0.0_dp
3749 END IF
3750 myfmin(1)=min(myfmin(1),fval)
3751 myfmax(1)=max(myfmax(1),fval)
3752 fval=fval*romsscale
3753 myfmin(2)=min(myfmin(2),fval)
3754 myfmax(2)=max(myfmax(2),fval)
3755 forces(ng)%shflx(i,j)=fval
3756 END DO
3757 END DO
3758!
3759! Surface net heat flux (Celsius m s-1).
3760!
3761 CASE ('nflx', 'shflux')
3762 romsscale=tracerfluxscale
3763 ifield=idtsur(itemp)
3764 gtype=r2dvar
3765 tindex=3-iinfo(8,ifield,ng)
3766 DO j=jstrr,jendr
3767 DO i=istrr,iendr
3768 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3769 fval=scale*ptr2d(i,j)+add_offset
3770 ELSE
3771 fval=0.0_dp
3772 END IF
3773 myfmin(1)=min(myfmin(1),fval)
3774 myfmax(1)=max(myfmax(1),fval)
3775 fval=fval*romsscale
3776 myfmin(2)=min(myfmin(2),fval)
3777 myfmax(2)=max(myfmax(2),fval)
3778# ifdef TIME_INTERP
3779 forces(ng)%stfluxG(i,j,tindex,itemp)=fval
3780# else
3781 forces(ng)%stflux(i,j,itemp)=fval
3782# endif
3783 END DO
3784 END DO
3785# ifndef TIME_INTERP
3786 IF (localde.eq.localdecount-1) THEN
3787 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3788 CALL exchange_r2d_tile (ng, tile, &
3789 & lbi, ubi, lbj, ubj, &
3790 & forces(ng)%stflux(:,:,itemp))
3791 END IF
3792 CALL mp_exchange2d (ng, tile, inlm, 1, &
3793 & lbi, ubi, lbj, ubj, &
3794 & nghostpoints, &
3795 & ewperiodic(ng), nsperiodic(ng), &
3796 & forces(ng)%stflux(:,:,itemp))
3797 END IF
3798# endif
3799# endif
3800# if !defined BULK_FLUXES && defined SALINITY
3801!
3802! Surface net freshwater flux: E-P (m s-1).
3803!
3804 CASE ('sflx', 'swflux')
3805 romsscale=freshwaterscale
3806 ifield=idtsur(isalt)
3807 gtype=r2dvar
3808 tindex=3-iinfo(8,ifield,ng)
3809 DO j=jstrr,jendr
3810 DO i=istrr,iendr
3811 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3812 fval=scale*ptr2d(i,j)+add_offset
3813 ELSE
3814 fval=0.0_dp
3815 END IF
3816 myfmin(1)=min(myfmin(1),fval)
3817 myfmax(1)=max(myfmax(1),fval)
3818 fval=fval*romsscale
3819 myfmin(2)=min(myfmin(2),fval)
3820 myfmax(2)=max(myfmax(2),fval)
3821# ifdef TIME_INTERP
3822 forces(ng)%stfluxG(i,j,tindex,isalt)=fval
3823# else
3824 forces(ng)%stflux(i,j,isalt)=fval
3825# endif
3826 END DO
3827 END DO
3828# ifndef TIME_INTERP
3829 IF (localde.eq.localdecount-1) THEN
3830 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3831 CALL exchange_r2d_tile (ng, tile, &
3832 & lbi, ubi, lbj, ubj, &
3833 & forces(ng)%stflux(:,:,isalt))
3834 END IF
3835 CALL mp_exchange2d (ng, tile, inlm, 1, &
3836 & lbi, ubi, lbj, ubj, &
3837 & nghostpoints, &
3838 & ewperiodic(ng), nsperiodic(ng), &
3839 & forces(ng)%stflux(:,:,isalt))
3840 END IF
3841# endif
3842# endif
3843# if !defined BULK_FLUXES
3844!
3845! Surface eastward wind stress component (m2 s-2). Imported stress
3846! component is at RHO-points.
3847!
3848 CASE ('taux', 'sustr')
3849 IF (.not.allocated(ustress)) THEN
3850 allocate ( ustress(lbi:ubi,lbj:ubj) )
3851 ustress=missing_dp
3852 END IF
3853 got_stress(1)=.true.
3854 romsscale=stressscale
3855 ifield=idusms
3856 gtype=u2dvar
3857 tindex=3-iinfo(8,ifield,ng)
3858 DO j=jstrr,jendr
3859 DO i=istrr,iendr
3860 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3861 fval=scale*ptr2d(i,j)+add_offset
3862 ELSE
3863 fval=0.0_dp
3864 END IF
3865 myfmin(1)=min(myfmin(1),fval)
3866 myfmax(1)=max(myfmax(1),fval)
3867 fval=fval*romsscale
3868 myfmin(2)=min(myfmin(2),fval)
3869 myfmax(2)=max(myfmax(2),fval)
3870# ifdef TIME_INTERP
3871 forces(ng)%sustrG(i,j,tindex)=fval
3872# else
3873 ustress(i,j)=fval
3874# endif
3875 END DO
3876 END DO
3877 IF (localde.eq.localdecount-1) THEN
3878 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3879 CALL exchange_r2d_tile (ng, tile, &
3880 & lbi, ubi, lbj, ubj, &
3881 & ustress)
3882 END IF
3883 CALL mp_exchange2d (ng, tile, inlm, 1, &
3884 & lbi, ubi, lbj, ubj, &
3885 & nghostpoints, &
3886 & ewperiodic(ng), nsperiodic(ng), &
3887 & ustress)
3888 END IF
3889# endif
3890# if !defined BULK_FLUXES
3891!
3892! Surface northward wind stress component (m2 s-2). Imported stress
3893! component is at RHO-points.
3894!
3895 CASE ('tauy', 'svstr')
3896 IF (.not.allocated(vstress)) THEN
3897 allocate ( vstress(lbi:ubi,lbj:ubj) )
3898 vstress=missing_dp
3899 END IF
3900 got_stress(2)=.true.
3901 romsscale=stressscale
3902 ifield=idvsms
3903 gtype=v2dvar
3904 tindex=3-iinfo(8,ifield,ng)
3905 DO j=jstrr,jendr
3906 DO i=istrr,iendr
3907 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3908 fval=scale*ptr2d(i,j)+add_offset
3909 ELSE
3910 fval=0.0_dp
3911 END IF
3912 myfmin(1)=min(myfmin(1),fval)
3913 myfmax(1)=max(myfmax(1),fval)
3914 fval=fval*romsscale
3915 myfmin(2)=min(myfmin(2),fval)
3916 myfmax(2)=max(myfmax(2),fval)
3917# ifdef TIME_INTERP
3918 forces(ng)%svstrG(i,j,tindex)=fval
3919# else
3920 vstress(i,j)=fval
3921# endif
3922 END DO
3923 END DO
3924 IF (localde.eq.localdecount-1) THEN
3925 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3926 CALL exchange_r2d_tile (ng, tile, &
3927 & lbi, ubi, lbj, ubj, &
3928 & vstress)
3929 END IF
3930 CALL mp_exchange2d (ng, tile, inlm, 1, &
3931 & lbi, ubi, lbj, ubj, &
3932 & nghostpoints, &
3933 & ewperiodic(ng), nsperiodic(ng), &
3934 & vstress)
3935 END IF
3936# endif
3937# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
3938!
3939! Surface air density (kg/m3).
3940!
3941 CASE ('RhoAir')
3942 IF (.not.allocated(rhoair)) THEN
3943 allocate ( rhoair(lbi:ubi,lbj:ubj) )
3944 rhoair=missing_dp
3945 END IF
3946 got_rhoair=.true.
3947 romsscale=scale
3948 DO j=jstrr,jendr
3949 DO i=istrr,iendr
3950 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3951 fval=scale*ptr2d(i,j)+add_offset
3952 ELSE
3953 fval=0.0_dp
3954 END IF
3955 myfmin(1)=min(myfmin(1),fval)
3956 myfmax(1)=max(myfmax(1),fval)
3957 fval=fval*romsscale
3958 myfmin(2)=min(myfmin(2),fval)
3959 myfmax(2)=max(myfmax(2),fval)
3960 rhoair(i,j)=fval
3961 END DO
3962 END DO
3963 IF (localde.eq.localdecount-1) THEN
3964 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3965 CALL exchange_r2d_tile (ng, tile, &
3966 & lbi, ubi, lbj, ubj, &
3967 & rhoair)
3968 END IF
3969 CALL mp_exchange2d (ng, tile, inlm, 1, &
3970 & lbi, ubi, lbj, ubj, &
3971 & nghostpoints, &
3972 & ewperiodic(ng), nsperiodic(ng), &
3973 & rhoair)
3974 END IF
3975!
3976! Eastward wind component (m s-1) at surface boundary layer. Imported
3977! wind component is at RHO-points.
3978!
3979 CASE ('Uwind_sbl')
3980 IF (.not.allocated(xwind)) THEN
3981 allocate ( xwind(lbi:ubi,lbj:ubj) )
3982 xwind=missing_dp
3983 END IF
3984 got_wind_sbl(1)=.true.
3985 romsscale=scale
3986 DO j=jstrr,jendr
3987 DO i=istrr,iendr
3988 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3989 fval=scale*ptr2d(i,j)+add_offset
3990 ELSE
3991 fval=0.0_dp
3992 END IF
3993 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3994 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3995 fval=fval*romsscale
3996 myfmin(2)=min(myfmin(2),fval)
3997 myfmax(2)=max(myfmax(2),fval)
3998 xwind(i,j)=fval
3999 END DO
4000 END DO
4001 IF (localde.eq.localdecount-1) THEN
4002 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4003 CALL exchange_r2d_tile (ng, tile, &
4004 & lbi, ubi, lbj, ubj, &
4005 & xwind)
4006 END IF
4007 CALL mp_exchange2d (ng, tile, inlm, 1, &
4008 & lbi, ubi, lbj, ubj, &
4009 & nghostpoints, &
4010 & ewperiodic(ng), nsperiodic(ng), &
4011 & xwind)
4012 END IF
4013!
4014! Northward wind component (m s-1) at surface boundary layer. Imported
4015! wind component is at RHO-points.
4016!
4017 CASE ('Vwind_sbl')
4018 IF (.not.allocated(ywind)) THEN
4019 allocate ( ywind(lbi:ubi,lbj:ubj) )
4020 ywind=missing_dp
4021 END IF
4022 got_wind_sbl(2)=.true.
4023 romsscale=scale
4024 DO j=jstrr,jendr
4025 DO i=istrr,iendr
4026 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4027 fval=scale*ptr2d(i,j)+add_offset
4028 ELSE
4029 fval=0.0_dp
4030 END IF
4031 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4032 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4033 fval=fval*romsscale
4034 myfmin(2)=min(myfmin(2),fval)
4035 myfmax(2)=max(myfmax(2),fval)
4036 ywind(i,j)=fval
4037 END DO
4038 END DO
4039 IF (localde.eq.localdecount-1) THEN
4040 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4041 CALL exchange_r2d_tile (ng, tile, &
4042 & lbi, ubi, lbj, ubj, &
4043 & ywind)
4044 END IF
4045 CALL mp_exchange2d (ng, tile, inlm, 1, &
4046 & lbi, ubi, lbj, ubj, &
4047 & nghostpoints, &
4048 & ewperiodic(ng), nsperiodic(ng), &
4049 & ywind)
4050 END IF
4051!
4052! Surface frictional wind magnitude (m s-1) from similarity theory.
4053! Imported wind magnitude is at RHO-points.
4054!
4055 CASE ('Wstar')
4056 IF (.not.allocated(wstar)) THEN
4057 allocate ( wstar(lbi:ubi,lbj:ubj) )
4058 wstar=missing_dp
4059 END IF
4060 got_wstar=.true.
4061 romsscale=scale
4062 DO j=jstrr,jendr
4063 DO i=istrr,iendr
4064 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4065 fval=scale*ptr2d(i,j)+add_offset
4066 ELSE
4067 fval=0.0_dp
4068 END IF
4069 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4070 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4071 fval=fval*romsscale
4072 myfmin(2)=min(myfmin(2),fval)
4073 myfmax(2)=max(myfmax(2),fval)
4074 wstar(i,j)=fval
4075 END DO
4076 END DO
4077 IF (localde.eq.localdecount-1) THEN
4078 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4079 CALL exchange_r2d_tile (ng, tile, &
4080 & lbi, ubi, lbj, ubj, &
4081 & wstar)
4082 END IF
4083 CALL mp_exchange2d (ng, tile, inlm, 1, &
4084 & lbi, ubi, lbj, ubj, &
4085 & nghostpoints, &
4086 & ewperiodic(ng), nsperiodic(ng), &
4087 & wstar)
4088 END IF
4089# endif
4090!
4091! Import field not found.
4092!
4093 CASE DEFAULT
4094 IF (localpet.eq.0) THEN
4095 WRITE (cplout,10) trim(importnamelist(ifld)), &
4096 & trim(time_currentstring), &
4097 & trim(cinpname)
4098 END IF
4099 exit_flag=9
4100 IF (founderror(exit_flag, noerror, __line__, &
4101 & myfile)) THEN
4102 rc=esmf_rc_not_found
4103 RETURN
4104 END IF
4105 END SELECT
4106!
4107! Print pointer information.
4108!
4109 IF (debuglevel.eq.4) THEN
4110 WRITE (cplout,20) localpet, localde, &
4111 & lbound(ptr2d,dim=1), ubound(ptr2d,dim=1), &
4112 & lbound(ptr2d,dim=2), ubound(ptr2d,dim=2), &
4113 & istrr, iendr, jstrr, jendr
4114 END IF
4115!
4116! Nullify pointer to make sure that it does not point on a random
4117! part in the memory.
4118!
4119 IF (associated(ptr2d)) nullify (ptr2d)
4120 END DO de_loop
4121!
4122! Get import field minimun and maximum values.
4123!
4124 CALL esmf_vmallreduce (vm, &
4125 & senddata=myfmin, &
4126 & recvdata=fmin, &
4127 & count=2, &
4128 & reduceflag=esmf_reduce_min, &
4129 & rc=rc)
4130 IF (esmf_logfounderror(rctocheck=rc, &
4131 & msg=esmf_logerr_passthru, &
4132 & line=__line__, &
4133 & file=myfile)) THEN
4134 RETURN
4135 END IF
4136!
4137 CALL esmf_vmallreduce (vm, &
4138 & senddata=myfmax, &
4139 & recvdata=fmax, &
4140 & count=2, &
4141 & reduceflag=esmf_reduce_max, &
4142 & rc=rc)
4143 IF (esmf_logfounderror(rctocheck=rc, &
4144 & msg=esmf_logerr_passthru, &
4145 & line=__line__, &
4146 & file=myfile)) THEN
4147 RETURN
4148 END IF
4149!
4150! Write out import field information.
4151!
4152 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
4153 WRITE (cplout,30) trim(importnamelist(ifld)), &
4154# ifdef TIME_INTERP
4155 & trim(mydate(tindex)), ng, &
4156 & fmin(1), fmax(1), tindex
4157# else
4158 & trim(time_currentstring), ng, &
4159 & fmin(1), fmax(1)
4160# endif
4161 IF (romsscale.ne.1.0_dp) THEN
4162 WRITE (cplout,40) fmin(2), fmax(2), &
4163 & ' romsScale = ', romsscale
4164 ELSE IF (add_offset.ne.0.0_dp) THEN
4165 WRITE (cplout,40) fmin(2), fmax(2), &
4166 & ' AddOffset = ', add_offset
4167 END IF
4168 END IF
4169
4170# ifdef TIME_INTERP
4171!
4172! Load ROMS metadata information needed for time interpolation and
4173! reporting.
4174!
4175 IF (loadit) THEN
4176 linfo(1,ifield,ng)=.true. ! Lgrided
4177 linfo(3,ifield,ng)=.false. ! Lonerec
4178 iinfo(1,ifield,ng)=gtype
4179 iinfo(8,ifield,ng)=tindex
4180 finfo(1,ifield,ng)=tmin
4181 finfo(2,ifield,ng)=tmax
4182 finfo(3,ifield,ng)=tstr
4183 finfo(4,ifield,ng)=tend
4184 finfo(8,ifield,ng)=fmin(1)
4185 finfo(9,ifield,ng)=fmax(1)
4186 vtime(tindex,ifield,ng)=myvtime(tindex)
4187 tintrp(tindex,ifield,ng)=mytintrp(tindex)*86400.0_dp
4188 END IF
4189# endif
4190!
4191! Debugging: write out import field into NetCDF file.
4192!
4193 IF ((debuglevel.ge.3).and. &
4194 & models(iroms)%ImportField(id)%debug_write) THEN
4195 WRITE (ofile,50) ng, trim(importnamelist(ifld)), &
4196 & year, month, day, hour, minutes, seconds
4197 CALL esmf_fieldwrite (field, &
4198 & trim(ofile), &
4199 & overwrite=.true., &
4200 & rc=rc)
4201 IF (esmf_logfounderror(rctocheck=rc, &
4202 & msg=esmf_logerr_passthru, &
4203 & line=__line__, &
4204 & file=myfile)) THEN
4205 RETURN
4206 END IF
4207 END IF
4208
4209 END DO fld_loop
4210
4211# if defined BULK_FLUXES || defined ECOSIM
4212!
4213! If applicable, rotate wind components to ROMS curvilinear grid.
4214!
4215 IF (got_wind(1).and.got_wind(2)) THEN
4216 CALL roms_rotate (ng, tile, geo2grid_rho, &
4217 & lbi, ubi, lbj, ubj, &
4218 & uwind, vwind, &
4219 & forces(ng)%Uwind, forces(ng)%Vwind)
4220 deallocate (uwind)
4221 deallocate (vwind)
4222 END IF
4223# endif
4224# if !defined BULK_FLUXES
4225!
4226! If applicable, rotate wind stress components to ROMS curvilinear
4227! grid.
4228!
4229 IF (got_stress(1).and.got_stress(2)) THEN
4230 CALL roms_rotate (ng, tile, geo2grid, &
4231 & lbi, ubi, lbj, ubj, &
4232 & ustress, vstress, &
4233 & forces(ng)%sustr, forces(ng)%svstr)
4234 deallocate (ustress)
4235 deallocate (vstress)
4236 END IF
4237# endif
4238# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
4239!
4240! If applicable, compute surface wind stress components. The surface
4241! ocean currents are substracted to the wind.
4242!
4243! The wind stress component are computed as:
4244!
4245! taux/rho0 = RhoAir * Cd * Wrel * Urel
4246! tauy/rho0 = RhoAir * Cd * Wrel * Vrel
4247! where
4248! Cd = Wstr**2 / Wmag**2
4249!
4250! so the magnitude is diminished by the weaker relative (wind minus
4251! current) components. The coupling is incompleate becasue there is
4252! not feeback to the atmosphere (wind is not modified by currents).
4253!
4254 myfmin= missing_dp
4255 myfmax=-missing_dp
4256!
4257 IF (got_rhoair.and.got_wstar.and. &
4258 & got_wind_sbl(1).and.got_wind_sbl(2)) THEN
4259 IF (.not.allocated(uwrk)) THEN
4260 allocate ( uwrk(lbi:ubi,lbj:ubj) )
4261 uwrk=missing_dp
4262 END IF
4263 IF (.not.allocated(vwrk)) THEN
4264 allocate ( vwrk(lbi:ubi,lbj:ubj) )
4265 vwrk=missing_dp
4266 END IF
4267!
4268 CALL roms_rotate (ng, tile, grid2geo_rho, &
4269 & lbi, ubi, lbj, ubj, &
4270 & ocean(ng)%u(:,:,n(ng),nstp(ng)), &
4271 & ocean(ng)%v(:,:,n(ng),nstp(ng)), &
4272 & uwrk, vwrk) ! rotated currents to E-N
4273!
4274 DO j=jstr-1,jend+1
4275 DO i=istr-1,iend+1
4276 romsscale=stressscale ! m3/kg
4277 urel=xwind(i,j)-uwrk(i,j) ! relative wind:
4278 vrel=ywind(i,j)-vwrk(i,j) ! wind minus current
4279 wmag=sqrt(xwind(i,j)*xwind(i,j)+ &
4280 & ywind(i,j)*ywind(i,j)) ! ATM wind magnitude
4281 wrel=sqrt(urel*urel+vrel*vrel) ! relative magmitude
4282 cff1=romsscale*rhoair(i,j)
4283 cff2=wstar(i,j)*wstar(i,j)/(wmag*wmag+eps)
4284 cff3=cff1*cff2*wrel ! m/s
4285 uwrk(i,j)=cff3*urel ! m2/s2
4286 vwrk(i,j)=cff3*vrel ! m2/s2
4287 myfmin(1)=min(myfmin(1),uwrk(i,j))
4288 myfmin(2)=min(myfmin(2),vwrk(i,j))
4289 myfmax(1)=max(myfmax(1),uwrk(i,j))
4290 myfmax(2)=max(myfmax(2),vwrk(i,j))
4291 END DO
4292 END DO
4293 deallocate (rhoair)
4294 deallocate (wstar)
4295 deallocate (xwind)
4296 deallocate (ywind)
4297! ! rotate stress to grid
4298 CALL roms_rotate (ng, tile, geo2grid, &
4299 & lbi, ubi, lbj, ubj, &
4300 & uwrk, vwrk, &
4301 & forces(ng)%sustr, &
4302 & forces(ng)%svstr)
4303 deallocate (uwrk)
4304 deallocate (vwrk)
4305!
4306! Report computed wind stress minimum and maximum values.
4307!
4308 IF (debuglevel.ge.0) THEN
4309 CALL esmf_vmallreduce (vm, &
4310 & senddata=myfmin, &
4311 & recvdata=fmin, &
4312 & count=2, &
4313 & reduceflag=esmf_reduce_min, &
4314 & rc=rc)
4315 IF (esmf_logfounderror(rctocheck=rc, &
4316 & msg=esmf_logerr_passthru, &
4317 & line=__line__, &
4318 & file=myfile)) THEN
4319 RETURN
4320 END IF
4321!
4322 CALL esmf_vmallreduce (vm, &
4323 & senddata=myfmax, &
4324 & recvdata=fmax, &
4325 & count=2, &
4326 & reduceflag=esmf_reduce_max, &
4327 & rc=rc)
4328 IF (esmf_logfounderror(rctocheck=rc, &
4329 & msg=esmf_logerr_passthru, &
4330 & line=__line__, &
4331 & file=myfile)) THEN
4332 RETURN
4333 END IF
4334!
4335 IF (localpet.eq.0) THEN
4336 WRITE (cplout,60) 'sustr', &
4337 & trim(time_currentstring), ng, &
4338 & fmin(1)/stressscale, &
4339 & fmax(1)/stressscale
4340 WRITE (cplout,40) fmin(1), fmax(1), &
4341 & ' romsScale = ', stressscale
4342!
4343 WRITE (cplout,60) 'svstr', &
4344 & trim(time_currentstring), ng, &
4345 & fmin(2)/stressscale, &
4346 & fmax(2)/stressscale
4347 WRITE (cplout,40) fmin(2), fmax(2), &
4348 & ' romsScale = ', stressscale
4349 END IF
4350 END IF
4351 END IF
4352# endif
4353!
4354! Deallocate local arrays.
4355!
4356 IF (allocated(importnamelist)) deallocate (importnamelist)
4357!
4358! Update ROMS import calls counter.
4359!
4360 IF (importcount.gt.0) THEN
4361 models(iroms)%ImportCalls=models(iroms)%ImportCalls+1
4362 END IF
4363!
4364 IF (esm_track) THEN
4365 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Import', &
4366 & ', PET', petrank
4367 FLUSH (trac)
4368 END IF
4369 IF (debuglevel.gt.0) FLUSH (cplout)
4370!
4371 10 FORMAT (/,3x,' ROMS_Import - unable to find option to import: ', &
4372 & a,t72,a,/,18x,'check ''Import(roms)'' in input script: ', &
4373 & a)
4374 20 FORMAT (18x,'PET/DE [',i3.3,'/',i2.2,'], Pointer Size: ',4i8, &
4375 & /,36x,'Tiling Range: ',4i8)
4376 30 FORMAT (3x,' ROMS_Import - ESMF: importing field ''',a,'''', &
4377 & t72,a,2x,'Grid ',i2.2, &
4378# ifdef TIME_INTERP
4379 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
4380 & ' SnapshotIndex = ',i1,')')
4381# else
4382 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
4383 & ')')
4384# endif
4385 40 FORMAT (19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
4386 & 1x,a,1p,e15.8,0p,')')
4387 50 FORMAT ('roms_',i2.2,'_import_',a,'_',i4.4,2('-',i2.2),'_', &
4388 & i2.2,2('.',i2.2),'.nc')
4389 60 FORMAT (3x,' ROMS_Import - ESMF: computing field ''',a,'''', &
4390 & t72,a,2x,'Grid ',i2.2, &
4391 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
4392 & ')')
4393!
4394 RETURN

References mod_esmf_esm::attfilename, mod_param::bounds, mod_esmf_esm::cinpname, mod_scalars::cp, mod_esmf_esm::cplout, mod_esmf_esm::debuglevel, mod_kinds::dp, mod_esmf_esm::esm_track, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_scalars::exit_flag, mod_esmf_esm::field_index(), mod_ncparam::finfo, mod_forces::forces, strings_mod::founderror(), geo2grid, geo2grid_rho, grid2geo_rho, mod_ncparam::idldwn, mod_ncparam::idlrad, mod_ncparam::idpair, mod_ncparam::idqair, mod_ncparam::idrain, mod_ncparam::idsrad, mod_ncparam::idtair, mod_ncparam::idtsur, mod_ncparam::iduair, mod_ncparam::idusms, mod_ncparam::idvair, mod_ncparam::idvsms, mod_ncparam::iinfo, mod_param::inlm, mod_esmf_esm::iroms, mod_scalars::isalt, mod_scalars::itemp, mod_ncparam::linfo, mod_esmf_esm::missing_dp, mod_param::mm, mod_esmf_esm::models, mp_exchange_mod::mp_exchange2d(), mod_param::n, mod_param::nghostpoints, mod_scalars::noerror, mod_scalars::nsperiodic, mod_stepping::nstp, mod_ocean::ocean, mod_esmf_esm::petlayoutoption, mod_esmf_esm::petrank, mod_param::r2dvar, mod_scalars::rclock, mod_scalars::rho0, dateclock_mod::roms_clock(), roms_rotate(), mod_iounits::sourcefile, mod_ncparam::tintrp, mod_esmf_esm::tol_dp, mod_esmf_esm::trac, mod_param::u2dvar, mod_param::v2dvar, and mod_ncparam::vtime.

Referenced by roms_modeladvance().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_modeladvance()

subroutine, private esmf_roms_mod::roms_modeladvance ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 2438 of file esmf_roms.h.

2439!
2440!=======================================================================
2441! !
2442! Advance ROMS component for a coupling interval (seconds) using !
2443! "ROMS_run". It also calls "ROMS_Import" and "ROMS_Export" to !
2444! import and export coupling fields, respectively. !
2445! !
2446! During configuration, the driver clock was decreased by a single !
2447! coupling interval (TimeStep) to allow the proper initialization !
2448! of the import and export fields pointers. ROMS is not advanced !
2449! on the first call to this routine, so the time stepping is over !
2450! the specified application start and ending dates. !
2451! !
2452# if defined TIME_INTERP
2453! On the first pass, it imports the LOWER time snapshot fields, !
2454! but cannot time-step ROMS until the next call after importing !
2455! the UPPER snapshot. Therefore, it starts time-stepping when !
2456! both LOWER and UPPER time snapshot fields are exchanged so that !
2457! ROMS can perform time interpolation. !
2458# else
2459! ROMS is actually advanced on the second call to this routine. !
2460# endif
2461! !
2462!=======================================================================
2463!
2464! Imported variable declarations.
2465!
2466 integer, intent(out) :: rc
2467!
2468 TYPE (ESMF_GridComp) :: model
2469!
2470! Local variable declarations.
2471!
2472 logical :: Ladvance
2473 integer :: is, ng
2474 integer :: MyTask, PETcount, localPET, phase
2475!
2476 real (dp) :: CouplingInterval, RunInterval
2477 real (dp) :: TcurrentInSeconds, TstopInSeconds
2478!
2479 character (len=22) :: Cinterval
2480 character (len=22) :: CurrTimeString, StopTimeString
2481
2482 character (len=*), parameter :: MyFile = &
2483 & __FILE__//", ROMS_SetModelAdvance"
2484!
2485 TYPE (ESMF_Clock) :: clock
2486 TYPE (ESMF_State) :: ExportState, ImportState
2487 TYPE (ESMF_Time) :: ReferenceTime
2488 TYPE (ESMF_Time) :: CurrentTime, StopTime
2489 TYPE (ESMF_TimeInterval) :: TimeStep
2490 TYPE (ESMF_VM) :: vm
2491!
2492!-----------------------------------------------------------------------
2493! Initialize return code flag to success state (no error).
2494!-----------------------------------------------------------------------
2495!
2496 IF (esm_track) THEN
2497 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_ModelAdvance', &
2498 & ', PET', petrank
2499 FLUSH (trac)
2500 END IF
2501 rc=esmf_success
2502!
2503!-----------------------------------------------------------------------
2504! Get information about the gridded component.
2505!-----------------------------------------------------------------------
2506!
2507! Inquire about ROMS component.
2508!
2509 CALL esmf_gridcompget (model, &
2510 & importstate=importstate, &
2511 & exportstate=exportstate, &
2512 & clock=clock, &
2513 & localpet=localpet, &
2514 & petcount=petcount, &
2515 & currentphase=phase, &
2516 & vm=vm, &
2517 & rc=rc)
2518 IF (esmf_logfounderror(rctocheck=rc, &
2519 & msg=esmf_logerr_passthru, &
2520 & line=__line__, &
2521 & file=myfile)) THEN
2522 RETURN
2523 END IF
2524!
2525! Get time step interval, stopping time, reference time, and current
2526! time.
2527!
2528 CALL esmf_clockget (clock, &
2529 & timestep=timestep, &
2530 & stoptime=stoptime, &
2531 & reftime=referencetime, &
2532 & currtime=clockinfo(iroms)%CurrentTime, &
2533 & rc=rc)
2534 IF (esmf_logfounderror(rctocheck=rc, &
2535 & msg=esmf_logerr_passthru, &
2536 & line=__line__, &
2537 & file=myfile)) THEN
2538 RETURN
2539 END IF
2540!
2541! Current ROMS time (seconds).
2542!
2543 CALL esmf_timeget (clockinfo(iroms)%CurrentTime, &
2544 & s_r8=tcurrentinseconds, &
2545 & timestringisofrac=currtimestring, &
2546 & rc=rc)
2547 IF (esmf_logfounderror(rctocheck=rc, &
2548 & msg=esmf_logerr_passthru, &
2549 & line=__line__, &
2550 & file=myfile)) THEN
2551 RETURN
2552 END IF
2553 is=index(currtimestring, 'T') ! remove 'T' in
2554 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
2555!
2556! ROMS stop time (seconds) for this coupling window.
2557!
2558 CALL esmf_timeget (clockinfo(iroms)%CurrentTime+timestep, &
2559 & s_r8=tstopinseconds, &
2560 & timestringisofrac=stoptimestring, &
2561 & rc=rc)
2562 IF (esmf_logfounderror(rctocheck=rc, &
2563 & msg=esmf_logerr_passthru, &
2564 & line=__line__, &
2565 & file=myfile)) THEN
2566 RETURN
2567 END IF
2568 is=index(stoptimestring, 'T') ! remove 'T' in
2569 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
2570!
2571! Get coupling time interval (seconds, double precision).
2572!
2573 CALL esmf_timeintervalget (timestep, &
2574 & s_r8=couplinginterval, &
2575 & rc=rc)
2576 IF (esmf_logfounderror(rctocheck=rc, &
2577 & msg=esmf_logerr_passthru, &
2578 & line=__line__, &
2579 & file=myfile)) THEN
2580 RETURN
2581 END IF
2582!
2583! Set ROMS running interval (seconds) for the current coupling window.
2584!
2585 runinterval=couplinginterval
2586!
2587! Set local model advance time stepping switch.
2588!
2589 ladvance=.true.
2590# ifdef TIME_INTERP
2591 IF ((models(iroms)%ImportCalls.eq.0).and. &
2592 & (nimport(iroms).gt.0)) THEN
2593 ladvance=.false.
2594 END IF
2595# else
2596# ifdef REGRESS_STARTCLOCK
2597 IF (tcurrentinseconds.eq.clockinfo(idriver)%Time_Start) THEN
2598 ladvance=.false.
2599 END IF
2600# endif
2601# endif
2602!
2603!-----------------------------------------------------------------------
2604! Report time information strings (YYYY-MM-DD hh:mm:ss).
2605!-----------------------------------------------------------------------
2606!
2607 IF (localpet.eq.0) THEN
2608 WRITE (cinterval,'(f15.2)') couplinginterval
2609 WRITE (cplout,10) trim(currtimestring), trim(stoptimestring), &
2610 & trim(adjustl(cinterval)), ladvance
2611 END IF
2612!
2613!-----------------------------------------------------------------------
2614! Get import fields from other ESM components.
2615!-----------------------------------------------------------------------
2616!
2617 IF (nimport(iroms).gt.0) THEN
2618 DO ng=1,models(iroms)%Ngrids
2619 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2620 CALL roms_import (ng, model, rc)
2621 IF (esmf_logfounderror(rctocheck=rc, &
2622 & msg=esmf_logerr_passthru, &
2623 & line=__line__, &
2624 & file=myfile)) THEN
2625 RETURN
2626 END IF
2627 END IF
2628 END DO
2629 END IF
2630!
2631!-----------------------------------------------------------------------
2632! Run ROMS component. Notice that ROMS component is advanced when
2633! ng=1. In nested application, ROMS kernel (main2d or main3d) will
2634! advance all the nested grid in their logical order. In nesting,
2635! the execution order of the grids is critical since nesting is
2636! two-way by default.
2637!-----------------------------------------------------------------------
2638!
2639 IF (ladvance) THEN
2640 IF (esm_track) THEN
2641 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Run', &
2642 & ', PET', petrank
2643 FLUSH (trac)
2644 END IF
2645 CALL roms_run (runinterval)
2646 IF (esm_track) THEN
2647 WRITE (trac,'(a,a,i0)') '==> Exiting ROMS_Run', &
2648 & ', PET', petrank
2649 FLUSH (trac)
2650 END IF
2651 END IF
2652!
2653 IF (exit_flag.ne.noerror) then
2654 IF (localpet.eq.0) then
2655 WRITE (cplout,'(a,i1)') 'ROMS component exit with flag = ', &
2656 & exit_flag
2657 END IF
2658 CALL roms_finalize
2659 CALL esmf_finalize (endflag=esmf_end_abort)
2660 END IF
2661!
2662!-----------------------------------------------------------------------
2663! Put export fields.
2664!-----------------------------------------------------------------------
2665!
2666 IF (nexport(iroms).gt.0) THEN
2667 DO ng=1,models(iroms)%Ngrids
2668 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2669 CALL roms_export (ng, model, rc)
2670 IF (esmf_logfounderror(rctocheck=rc, &
2671 & msg=esmf_logerr_passthru, &
2672 & line=__line__, &
2673 & file=myfile)) THEN
2674 RETURN
2675 END IF
2676 END IF
2677 END DO
2678 END IF
2679!
2680 IF (esm_track) THEN
2681 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_ModelAdvance', &
2682 & ', PET', petrank
2683 FLUSH (trac)
2684 END IF
2685!
2686 10 FORMAT (3x,'ModelAdvance - ESMF, Running ROMS:',t42,a, &
2687 & ' => ',a,', [',a,' s], Advance: ',l1)
2688!
2689 RETURN

References mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_esmf_esm::esm_track, mod_scalars::exit_flag, mod_esmf_esm::idriver, mod_esmf_esm::iroms, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::nimport, mod_scalars::noerror, mod_esmf_esm::petrank, roms_export(), roms_kernel_mod::roms_finalize(), roms_import(), roms_kernel_mod::roms_run(), mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_rotate()

subroutine, private esmf_roms_mod::roms_rotate ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lrotate,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
real (dp), dimension(lbi:ubi,lbj:ubj), intent(in) uinp,
real (dp), dimension(lbi:ubi,lbj:ubj), intent(in) vinp,
real (r8), dimension(lbi:ubi,lbj:ubj), intent(out) uout,
real (r8), dimension(lbi:ubi,lbj:ubj), intent(out) vout )
private

Definition at line 4929 of file esmf_roms.h.

4933!
4934!=======================================================================
4935! !
4936! It rotates exchanged vector components from computational grid to !
4937! geographical EAST and NORTH directions or vice versa acccording to !
4938! Lrotate flag: !
4939! !
4940! Lrotate = geo2grid_rho RHO-points rotation !
4941! Lrotate = grid2geo_rho Exporting interior RHO-points !
4942! Lrotate = geo2grid U- and V-points staggered rotation !
4943! !
4944!=======================================================================
4945!
4946! Imported variable declarations.
4947!
4948 integer, intent(in) :: ng, tile, Lrotate
4949 integer, intent(in) :: LBi, UBi, LBj, UBj
4950!
4951 real (dp), intent(in) :: Uinp(LBi:UBi,LBj:UBj)
4952 real (dp), intent(in) :: Vinp(LBi:UBi,LBj:UBj)
4953 real (r8), intent(out) :: Uout(LBi:UBi,LBj:UBj)
4954 real (r8), intent(out) :: Vout(LBi:UBi,LBj:UBj)
4955!
4956! Local variable declarations.
4957!
4958 integer :: i, j
4959 integer :: IstrR, IendR, JstrR, JendR
4960 integer :: Istr, Iend, Jstr, Jend
4961!
4962 real :: Urho, Vrho
4963!
4964 real (r8) :: Urot(LBi:UBi,LBj:UBj)
4965 real (r8) :: Vrot(LBi:UBi,LBj:UBj)
4966!
4967!-----------------------------------------------------------------------
4968! Initialize.
4969!-----------------------------------------------------------------------
4970!
4971 IF (esm_track) THEN
4972 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Rotate', &
4973 & ', PET', petrank
4974 FLUSH (trac)
4975 END IF
4976!
4977! Set horizontal tile bounds.
4978!
4979 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
4980 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
4981 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
4982 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
4983!
4984 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
4985 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
4986 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
4987 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
4988
4989# ifdef CURVGRID
4990!
4991!-----------------------------------------------------------------------
4992! Rotate from geographical (EAST, NORTH) to computational grid
4993! directions (ROMS import case).
4994!-----------------------------------------------------------------------
4995!
4996 IF ((lrotate.eq.geo2grid).or.(lrotate.eq.geo2grid_rho)) THEN
4997 DO j=jstrr,jendr
4998 DO i=istrr,iendr
4999 urot(i,j)=uinp(i,j)*grid(ng)%CosAngler(i,j)+ &
5000 & vinp(i,j)*grid(ng)%SinAngler(i,j)
5001 vrot(i,j)=vinp(i,j)*grid(ng)%CosAngler(i,j)- &
5002 & uinp(i,j)*grid(ng)%SinAngler(i,j)
5003 END DO
5004 END DO
5005!
5006! There is an option to import the rotated vector to staggered U- and
5007! V-locations (arithmetic avererage) or import vector at its native
5008! cell center (RHO-points).
5009!
5010 IF (lrotate.eq.geo2grid_rho) THEN ! RHO-points
5011 DO j=jstrr,jendr
5012 DO i=istrr,iendr
5013 uout(i,j)=urot(i,j)
5014 vout(i,j)=vrot(i,j)
5015 END DO
5016 END DO
5017!
5018 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5019 CALL exchange_r2d_tile (ng, tile, &
5020 & lbi, ubi, lbj, ubj, &
5021 & uout)
5022 CALL exchange_r2d_tile (ng, tile, &
5023 & lbi, ubi, lbj, ubj, &
5024 & vout)
5025 END IF
5026
5027 ELSE IF (lrotate.eq.geo2grid) THEN ! U- and V-points
5028 DO j=jstrr,jendr
5029 DO i=istr,iendr
5030 uout(i,j)=0.5_r8*(urot(i-1,j)+urot(i,j))
5031# ifdef MASKING
5032 uout(i,j)=uout(i,j)*grid(ng)%umask(i,j)
5033# endif
5034# ifdef WET_DRY
5035 uout(i,j)=uout(i,j)*grid(ng)%umask_wet(i,j)
5036# endif
5037 END DO
5038 END DO
5039 DO j=jstr,jendr
5040 DO i=istrr,iendr
5041 vout(i,j)=0.5_r8*(vrot(i,j-1)+vrot(i,j))
5042# ifdef MASKING
5043 vout(i,j)=vout(i,j)*grid(ng)%vmask(i,j)
5044# endif
5045# ifdef WET_DRY
5046 vout(i,j)=vout(i,j)*grid(ng)%vmask_wet(i,j)
5047# endif
5048 END DO
5049 END DO
5050
5051 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5052 CALL exchange_u2d_tile (ng, tile, &
5053 & lbi, ubi, lbj, ubj, &
5054 & uout)
5055 CALL exchange_v2d_tile (ng, tile, &
5056 & lbi, ubi, lbj, ubj, &
5057 & vout)
5058 END IF
5059 END IF
5060!
5061!-----------------------------------------------------------------------
5062! Rotate from computational grid to geographical (EAST, NORTH)
5063! directions (ROMS Export case: vector at RHO-points).
5064!-----------------------------------------------------------------------
5065!
5066 ELSE IF (lrotate.eq.grid2geo_rho) THEN
5067 uout=0.0_r8
5068 vout=0.0_r8
5069 DO j=jstr,jend
5070 DO i=istr,iend
5071 urho=0.5_r8*(uinp(i,j)+uinp(i+1,j))
5072 vrho=0.5_r8*(vinp(i,j)+vinp(i,j+1))
5073 uout(i,j)=urho*grid(ng)%CosAngler(i,j)- &
5074 & vrho*grid(ng)%SinAngler(i,j)
5075 vout(i,j)=vrho*grid(ng)%CosAngler(i,j)+ &
5076 & urho*grid(ng)%SinAngler(i,j)
5077# ifdef MASKING
5078 uout(i,j)=uout(i,j)*grid(ng)%rmask(i,j)
5079 vout(i,j)=vout(i,j)*grid(ng)%rmask(i,j)
5080# endif
5081# ifdef WET_DRY
5082 uout(i,j)=uout(i,j)*grid(ng)%rmask_wet(i,j)
5083 vout(i,j)=vout(i,j)*grid(ng)%rmask_wet(i,j)
5084# endif
5085 END DO
5086 END DO
5087!
5088 CALL bc_r2d_tile (ng, tile, &
5089 & lbi, ubi, lbj, ubj, &
5090 & uout)
5091 CALL bc_r2d_tile (ng, tile, &
5092 & lbi, ubi, lbj, ubj, &
5093 & vout)
5094!
5095 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5096 CALL exchange_r2d_tile (ng, tile, &
5097 & lbi, ubi, lbj, ubj, &
5098 & uout)
5099 CALL exchange_r2d_tile (ng, tile, &
5100 & lbi, ubi, lbj, ubj, &
5101 & vout)
5102 END IF
5103 END IF
5104# else
5105!
5106!-----------------------------------------------------------------------
5107! Otherwise, load unrotated components to staggered location. ROMS grid
5108! is not curvilinear (ROMS import case). It is very unlikely to have
5109! realistic applications that are not curvilinear and rotated).
5110!-----------------------------------------------------------------------
5111!
5112 IF (lrotate.eq.geo2grid_rho) THEN ! RHO-points
5113 DO j=jstrr,jendr
5114 DO i=istrr,iendr
5115 uout(i,j)=uinp(i,j)
5116 vout(i,j)=vinp(i,j)
5117 END DO
5118 END DO
5119!
5120 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5121 CALL exchange_r2d_tile (ng, tile, &
5122 & lbi, ubi, lbj, ubj, &
5123 & uout)
5124 CALL exchange_r2d_tile (ng, tile, &
5125 & lbi, ubi, lbj, ubj, &
5126 & vout)
5127 END IF
5128
5129 ELSE IF (lrotate.eq.geo2grid) THEN ! U- and V-points
5130 DO j=jstrr,jendr
5131 DO i=istr,iendr
5132 uout(i,j)=0.5_r8*(uinp(i-1,j)+uinp(i,j))
5133# ifdef MASKING
5134 uout(i,j)=uout(i,j)*grid(ng)%umask(i,j)
5135# endif
5136# ifdef WET_DRY
5137 uout(i,j)=uout(i,j)*grid(ng)%umask_wet(i,j)
5138# endif
5139 END DO
5140 END DO
5141 DO j=jstr,jendr
5142 DO i=istrr,iendr
5143 vout(i,j)=0.5_r8*(vinp(i,j-1)+vinp(i,j))
5144# ifdef MASKING
5145 vout(i,j)=vout(i,j)*grid(ng)%vmask(i,j)
5146# endif
5147# ifdef WET_DRY
5148 vout(i,j)=vout(i,j)*grid(ng)%vmask_wet(i,j)
5149# endif
5150 END DO
5151 END DO
5152!
5153 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5154 CALL exchange_u2d_tile (ng, tile, &
5155 & lbi, ubi, lbj, ubj, &
5156 & uout)
5157 CALL exchange_v2d_tile (ng, tile, &
5158 & lbi, ubi, lbj, ubj, &
5159 & vout)
5160 END IF
5161 END IF
5162# endif
5163!
5164!-----------------------------------------------------------------------
5165! Distributed-memory tile (halo) exchange.
5166!-----------------------------------------------------------------------
5167!
5168 CALL mp_exchange2d (ng, tile, inlm, 2, &
5169 & lbi, ubi, lbj, ubj, &
5170 & nghostpoints, &
5171 & ewperiodic(ng), nsperiodic(ng), &
5172 & uout, vout)
5173!
5174 IF (esm_track) THEN
5175 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Rotate', &
5176 & ', PET', petrank
5177 FLUSH (trac)
5178 END IF
5179!

References bc_2d_mod::bc_r2d_tile(), mod_param::bounds, mod_esmf_esm::esm_track, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), exchange_2d_mod::exchange_u2d_tile(), exchange_2d_mod::exchange_v2d_tile(), geo2grid, geo2grid_rho, mod_grid::grid, grid2geo_rho, mod_param::inlm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by roms_export(), and roms_import().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_setclock()

subroutine, private esmf_roms_mod::roms_setclock ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 845 of file esmf_roms.h.

846!
847!=======================================================================
848! !
849! Sets ROMS component date calendar, start and stop time, and !
850! coupling interval. At initilization, the variable "tdays" is !
851! the initial time meassured in fractional days since the reference !
852! time. !
853! !
854!=======================================================================
855!
856! Imported variable declarations.
857!
858 integer, intent(out) :: rc
859!
860 TYPE (ESMF_GridComp) :: model
861!
862! Local variable declarations.
863!
864 integer :: ng
865 integer :: ref_year, start_year, stop_year
866 integer :: ref_month, start_month, stop_month
867 integer :: ref_day, start_day, stop_day
868 integer :: ref_hour, start_hour, stop_hour
869 integer :: ref_minute, start_minute, stop_minute
870 integer :: ref_second, start_second, stop_second
871 integer :: PETcount, localPET
872 integer :: TimeFrac
873!
874 real(dp) :: MyStartTime, MyStopTime
875!
876 character (len= 22) :: Calendar
877 character (len= 22) :: StartTimeString, StopTimeString
878 character (len=160) :: message
879
880 character (len=*), parameter :: MyFile = &
881 & __FILE__//", ROMS_SetClock"
882!
883 TYPE (ESMF_CalKind_Flag) :: CalType
884 TYPE (ESMF_Clock) :: clock
885 TYPE (ESMF_VM) :: vm
886!
887!-----------------------------------------------------------------------
888! Initialize return code flag to success state (no error).
889!-----------------------------------------------------------------------
890!
891 IF (esm_track) THEN
892 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetClock', &
893 & ', PET', petrank
894 FLUSH (trac)
895 END IF
896 rc=esmf_success
897!
898!-----------------------------------------------------------------------
899! Querry the Virtual Machine (VM) parallel environmemt for the MPI
900! communicator handle and current node rank.
901!-----------------------------------------------------------------------
902!
903 CALL esmf_gridcompget (model, &
904 & localpet=localpet, &
905 & petcount=petcount, &
906 & vm=vm, &
907 & rc=rc)
908 IF (esmf_logfounderror(rctocheck=rc, &
909 & msg=esmf_logerr_passthru, &
910 & line=__line__, &
911 & file=myfile)) THEN
912 RETURN
913 END IF
914!
915!-----------------------------------------------------------------------
916! Create ROMS component clock.
917!-----------------------------------------------------------------------
918!
919! Set ROMS time reference: model time is meassured as seconds since
920! reference time. ESMF does not support the Proleptic Gregorian
921! Calendar that extends backward the dates preceeding 15 October 1582
922! which always have a year length of 365.2425 days.
923!
924 ref_year =rclock%year
925 ref_month =rclock%month
926 ref_day =rclock%day
927 ref_hour =rclock%hour
928 ref_minute=rclock%minutes
929 ref_second=rclock%seconds
930 calendar =trim(rclock%calendar)
931!
932 IF (int(time_ref).eq.-1) THEN
933 caltype=esmf_calkind_360day
934 ELSE
935 caltype=esmf_calkind_gregorian
936 END IF
937!
938 clockinfo(iroms)%Calendar=esmf_calendarcreate(caltype, &
939 & name=trim(calendar),&
940 & rc=rc)
941 IF (esmf_logfounderror(rctocheck=rc, &
942 & msg=esmf_logerr_passthru, &
943 & line=__line__, &
944 & file=myfile)) THEN
945 RETURN
946 END IF
947!
948! Set reference time.
949!
950 CALL esmf_timeset (clockinfo(iroms)%ReferenceTime, &
951 & yy=ref_year, &
952 & mm=ref_month, &
953 & dd=ref_day, &
954 & h =ref_hour, &
955 & m =ref_minute, &
956 & s =ref_second, &
957 & calendar=clockinfo(iroms)%Calendar, &
958 & rc=rc)
959 IF (esmf_logfounderror(rctocheck=rc, &
960 & msg=esmf_logerr_passthru, &
961 & line=__line__, &
962 & file=myfile)) THEN
963 RETURN
964 END IF
965
966# ifdef REGRESS_STARTCLOCK
967!
968! Set start time, use the minimum value of all nested grids. Notice
969! that a coupling interval is substracted since the driver clock was
970! regressed by that amount to properly initialize all ESM components.
971!
972 mystarttime=minval(tdays)-clockinfo(iroms)%Time_Step/86400.0_dp
973# else
974!
975! Set start time, use the minimum value of all nested grids.
976!
977 mystarttime=minval(tdays)
978# endif
979!
980 clockinfo(iroms)%Time_Start=mystarttime*86400.0_dp
981 CALL caldate (mystarttime, &
982 & yy_i=start_year, &
983 & mm_i=start_month, &
984 & dd_i=start_day, &
985 & h_i =start_hour, &
986 & m_i =start_minute, &
987 & s_i =start_second)
988 CALL time_string (clockinfo(iroms)%Time_Start, &
989 & clockinfo(iroms)%Time_StartString)
990!
991 CALL esmf_timeset (clockinfo(iroms)%StartTime, &
992 & yy=start_year, &
993 & mm=start_month, &
994 & dd=start_day, &
995 & h =start_hour, &
996 & m =start_minute, &
997 & s =start_second, &
998 & ms=0, &
999 & calendar=clockinfo(iroms)%Calendar, &
1000 & rc=rc)
1001 IF (esmf_logfounderror(rctocheck=rc, &
1002 & msg=esmf_logerr_passthru, &
1003 & line=__line__, &
1004 & file=myfile)) THEN
1005 RETURN
1006 END IF
1007!
1008! Set stop time, use the maximum value of all nested grids.
1009!
1010 mystoptime=0.0_dp
1011 DO ng=1,models(iroms)%Ngrids
1012 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1013 mystoptime=max(mystoptime, &
1014 & tdays(ng)+(real(ntimes(ng),dp)*dt(ng))*sec2day)
1015 END IF
1016 END DO
1017 clockinfo(iroms)%Time_Stop=mystoptime*86400.0_dp
1018 CALL caldate (mystoptime, &
1019 & yy_i=stop_year, &
1020 & mm_i=stop_month, &
1021 & dd_i=stop_day, &
1022 & h_i =stop_hour, &
1023 & m_i =stop_minute, &
1024 & s_i =stop_second)
1025 CALL time_string (clockinfo(iroms)%Time_Stop, &
1026 & clockinfo(iroms)%Time_StopString)
1027!
1028 CALL esmf_timeset (clockinfo(iroms)%StopTime, &
1029 & yy=stop_year, &
1030 & mm=stop_month, &
1031 & dd=stop_day, &
1032 & h =stop_hour, &
1033 & m =stop_minute, &
1034 & s =stop_second, &
1035 & calendar=clockinfo(iroms)%Calendar, &
1036 & rc=rc)
1037 IF (esmf_logfounderror(rctocheck=rc, &
1038 & msg=esmf_logerr_passthru, &
1039 & line=__line__, &
1040 & file=myfile)) THEN
1041 RETURN
1042 END IF
1043!
1044!-----------------------------------------------------------------------
1045! Modify component clock time step.
1046!-----------------------------------------------------------------------
1047!
1048 timefrac=0
1049 DO ng=1,models(iroms)%Ngrids
1050 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1051 timefrac=max(timefrac, &
1052 & maxval(models(iroms)%TimeFrac(ng,:), &
1053 & mask=models(:)%IsActive))
1054 END IF
1055 END DO
1056 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
1057 rc=esmf_rc_not_set ! cannot be 0
1058 IF (esmf_logfounderror(rctocheck=rc, &
1059 & msg=esmf_logerr_passthru, &
1060 & line=__line__, &
1061 & file=myfile)) THEN
1062 RETURN
1063 END IF
1064 END IF
1065!
1066 clockinfo(iroms)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
1067!
1068!-----------------------------------------------------------------------
1069! Create ROMS component clock.
1070!-----------------------------------------------------------------------
1071!
1072 clockinfo(iroms)%Name='ROMS_clock'
1073 clock=esmf_clockcreate(clockinfo(iroms)%TimeStep, &
1074 & clockinfo(iroms)%StartTime, &
1075 & stoptime =clockinfo(iroms)%StopTime, &
1076 & reftime =clockinfo(iroms)%ReferenceTime, &
1077 & name =trim(clockinfo(iroms)%Name), &
1078 & rc=rc)
1079 IF (esmf_logfounderror(rctocheck=rc, &
1080 & msg=esmf_logerr_passthru, &
1081 & line=__line__, &
1082 & file=myfile)) THEN
1083 RETURN
1084 END IF
1085 clockinfo(iroms)%Clock=clock
1086!
1087! Set ROMS component clock.
1088!
1089 CALL esmf_gridcompset (model, &
1090 & clock=clockinfo(iroms)%Clock, &
1091 & rc=rc)
1092 IF (esmf_logfounderror(rctocheck=rc, &
1093 & msg=esmf_logerr_passthru, &
1094 & line=__line__, &
1095 & file=myfile)) THEN
1096 RETURN
1097 END IF
1098!
1099! Get current time.
1100!
1101 CALL esmf_clockget (clockinfo(iroms)%Clock, &
1102 & currtime=clockinfo(iroms)%CurrentTime, &
1103 & rc=rc)
1104 IF (esmf_logfounderror(rctocheck=rc, &
1105 & msg=esmf_logerr_passthru, &
1106 & line=__line__, &
1107 & file=myfile)) THEN
1108 RETURN
1109 END IF
1110!
1111!-----------------------------------------------------------------------
1112! Compare driver time against ROMS component time.
1113!-----------------------------------------------------------------------
1114!
1115 IF (clockinfo(idriver)%Restarted) THEN
1116 starttimestring=clockinfo(idriver)%Time_RestartString
1117 ELSE
1118 starttimestring=clockinfo(idriver)%Time_StartString
1119 END IF
1120!
1121! Report start and stop time clocks.
1122!
1123 IF (localpet.eq.0) THEN
1124 WRITE (cplout,'(/)')
1125 WRITE (cplout,10) 'DRIVER Calendar: ', &
1126 & trim(clockinfo(idriver)%CalendarString), &
1127 & 'DRIVER Start Clock: ', &
1128 & trim(clockinfo(idriver)%Time_StartString), &
1129 & 'DRIVER Stop Clock: ', &
1130 & trim(clockinfo(idriver)%Time_StopString)
1131!
1132 WRITE (cplout,10) 'ROMS Calendar: ', &
1133 & trim(clockinfo(iroms)%CalendarString), &
1134 & 'ROMS Start Clock: ', &
1135 & trim(clockinfo(iroms)%Time_StartString), &
1136 & 'ROMS Stop Clock: ', &
1137 & trim(clockinfo(iroms)%Time_StopString)
1138 END IF
1139!
1140! Compare Driver and ROMS clocks.
1141!
1142 IF (clockinfo(iroms)%Time_StartString(1:19).ne. &
1143 & starttimestring(1:19)) THEN
1144 IF (localpet.eq.0) THEN
1145 WRITE (cplout,20) 'ROMS Start Time: ', &
1146 & clockinfo(iroms)%Time_StartString(1:19), &
1147 & 'Driver Start Time: ', &
1148 & trim(starttimestring), &
1149 & ' are not equal!'
1150 END IF
1151 message='Driver and ROMS start times do not match: '// &
1152 & 'please check the config files.'
1153 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1154 & msg=trim(message))
1155 RETURN
1156 END IF
1157!
1158 IF (clockinfo(iroms )%Time_StopString(1:19).ne. &
1159 & clockinfo(idriver)%Time_StopString(1:19)) THEN
1160 IF (localpet.eq.0) THEN
1161 WRITE (cplout,20) 'ROMS Stop Time: ', &
1162 & clockinfo(iroms )%Time_StopString(1:19), &
1163 & 'Driver Stop Time: ', &
1164 & trim(clockinfo(idriver)%Time_StopString), &
1165 & ' are not equal!'
1166 END IF
1167 message='Driver and ROMS stop times do not match: '// &
1168 & 'please check the config files.'
1169 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1170 & msg=trim(message))
1171 RETURN
1172 END IF
1173!
1174 IF (trim(clockinfo(iroms )%CalendarString).ne. &
1175 & trim(clockinfo(idriver)%CalendarString)) THEN
1176 IF (localpet.eq.0) THEN
1177 WRITE (cplout,20) 'ROMS Calendar: ', &
1178 & trim(clockinfo(iroms )%CalendarString), &
1179 & 'Driver Calendar: ', &
1180 & trim(clockinfo(idriver)%CalendarString), &
1181 & ' are not equal!'
1182 END IF
1183 message='Driver and ROMS calendars do not match: '// &
1184 & 'please check the config files.'
1185 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1186 & msg=trim(message))
1187 RETURN
1188 END IF
1189!
1190 IF (esm_track) THEN
1191 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetClock', &
1192 & ', PET', petrank
1193 FLUSH (trac)
1194 END IF
1195!
1196 10 FORMAT (2x,a,2x,a/,2x,a,2x,a,/,2x,a,2x,a,/)
1197 20 FORMAT (/,2x,a,a,/,2x,a,a,/,2x,a)
1198!
1199 RETURN

References dateclock_mod::caldate(), mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_kinds::dp, mod_scalars::dt, mod_esmf_esm::esm_track, mod_esmf_esm::idriver, mod_esmf_esm::iroms, mod_param::mm, mod_esmf_esm::models, mod_scalars::ntimes, mod_esmf_esm::petrank, mod_scalars::rclock, mod_scalars::sec2day, mod_scalars::tdays, mod_scalars::time_ref, dateclock_mod::time_string(), and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_setfinalize()

subroutine, private esmf_roms_mod::roms_setfinalize ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 2692 of file esmf_roms.h.

2695!
2696!=======================================================================
2697! !
2698! Finalize ROMS component execution. It calls ROMS_finalize. !
2699! !
2700!=======================================================================
2701!
2702! Imported variable declarations.
2703!
2704 integer, intent(out) :: rc
2705!
2706 TYPE (ESMF_Clock) :: clock
2707 TYPE (ESMF_GridComp) :: model
2708 TYPE (ESMF_State) :: ExportState
2709 TYPE (ESMF_State) :: ImportState
2710!
2711! Local variable declarations.
2712!
2713 character (len=*), parameter :: MyFile = &
2714 & __FILE__//", ROMS_SetFinalize"
2715!
2716!-----------------------------------------------------------------------
2717! Initialize return code flag to success state (no error).
2718!-----------------------------------------------------------------------
2719!
2720 IF (esm_track) THEN
2721 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetFinalize', &
2722 & ', PET', petrank
2723 FLUSH (trac)
2724 END IF
2725 rc=esmf_success
2726!
2727!-----------------------------------------------------------------------
2728! If ng=1, finalize ROMS component. In nesting applications this step
2729! needs to be done only once.
2730!-----------------------------------------------------------------------
2731!
2732 CALL roms_finalize
2733!
2734 IF (esm_track) THEN
2735 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetFinalize', &
2736 & ', PET', petrank
2737 FLUSH (trac)
2738 END IF
2739!
2740 RETURN

References mod_esmf_esm::esm_track, mod_esmf_esm::petrank, roms_kernel_mod::roms_finalize(), and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_setgridarrays()

subroutine, private esmf_roms_mod::roms_setgridarrays ( integer, intent(in) ng,
integer, intent(in) tile,
type (esmf_gridcomp), intent(inout) model,
integer, intent(out) rc )
private

Definition at line 1537 of file esmf_roms.h.

1538!
1539!=======================================================================
1540! !
1541! Sets ROMS component staggered, horizontal grids arrays and !
1542! land/sea mask, if any. !
1543! !
1544!=======================================================================
1545!
1546! Imported variable declarations.
1547!
1548 integer, intent(in) :: ng, tile
1549 integer, intent(out) :: rc
1550!
1551 TYPE (ESMF_GridComp), intent(inout) :: model
1552!
1553! Local variable declarations.
1554!
1555 integer :: MyTile, gtype, i, ivar, j, node
1556 integer :: Istr, Iend, Jstr, Jend
1557 integer :: IstrR, IendR, JstrR, JendR
1558 integer :: localDE, localDEcount
1559 integer :: staggerEdgeLWidth(2)
1560 integer :: staggerEdgeUWidth(2)
1561!
1562 integer, allocatable :: deBlockList(:,:,:)
1563 integer (i4b), pointer :: ptrM(:,:) => null() ! land/sea mask
1564!
1565 real (dp), pointer :: ptrA(:,:) => null() ! area
1566 real (dp), pointer :: ptrX(:,:) => null() ! longitude
1567 real (dp), pointer :: ptrY(:,:) => null() ! latitude
1568!
1569 character (len=*), parameter :: MyFile = &
1570 & __FILE__//", ROMS_SetGridArrays"
1571!
1572 TYPE (ESMF_DistGrid) :: distGrid
1573 TYPE (ESMF_StaggerLoc) :: staggerLoc
1574!
1575!-----------------------------------------------------------------------
1576! Initialize return code flag to success state (no error).
1577!-----------------------------------------------------------------------
1578!
1579 IF (esm_track) THEN
1580 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetGridArrays', &
1581 & ', PET', petrank
1582 FLUSH (trac)
1583 END IF
1584 rc=esmf_success
1585!
1586!-----------------------------------------------------------------------
1587! Set limits of the grid arrays based on tile decomposition (MPI rank)
1588! and nested grid number.
1589!-----------------------------------------------------------------------
1590!
1591 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
1592 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
1593 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
1594 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
1595!
1596 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
1597 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
1598 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
1599 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
1600!
1601! Set tiles lower and upper bounds for each decomposition element.
1602! In ROMS, the "exclusive region" for each decomposition element or
1603! horizontal tile ranges is bounded by (Istr:Iend, Jstr:Jend). Each
1604! tiled array is dimensioned as (LBi:UBi, LBj:UBj) which includes
1605! halo regions (usually 2 ghost points) and padding when appropriate
1606! (total/memory region). All ROMS arrays are horizontally dimensioned
1607! with the same bounds regardless if they are variables located at
1608! RHO-, PSI-, U-, or V-points. There is no halos at the boundary edges.
1609! The physical boundary is a U-points (east/west edges) and V-points
1610! (south/north edges). The boundary for RHO-points variables are
1611! located at half grid (dx,dy) distance away from the physical boundary
1612! at array indices(i=0; i=Lm+1) and (j=0; j=Mm+1).
1613!
1614! --------------------- UBj ESMF uses a very
1615! | | complicated array
1616! | Jend __________ | regions:
1617! | | | |
1618! | | | | * interior region
1619! | | | | * exclusive region
1620! | Jstr|__________| | * computational region
1621! | Istr Iend | * total (memory) region
1622! | |
1623! --------------------- LBj
1624! LBi UBi
1625!
1626 IF (.not.allocated(deblocklist)) THEN
1627 allocate ( deblocklist(2,2,ntilei(ng)*ntilej(ng)) )
1628 END IF
1629 DO mytile=0,ntilei(ng)*ntilej(ng)-1
1630 deblocklist(1,1,mytile+1)=bounds(ng)%Istr(mytile)
1631 deblocklist(1,2,mytile+1)=bounds(ng)%Iend(mytile)
1632 deblocklist(2,1,mytile+1)=bounds(ng)%Jstr(mytile)
1633 deblocklist(2,2,mytile+1)=bounds(ng)%Jend(mytile)
1634 END DO
1635!
1636!-----------------------------------------------------------------------
1637! Create ESMF DistGrid object based on model domain decomposition.
1638!-----------------------------------------------------------------------
1639!
1640! A single Decomposition Element (DE) per Persistent Execution Thread
1641! (PET).
1642!
1643 distgrid=esmf_distgridcreate(minindex=(/ 1, 1 /), &
1644 & maxindex=(/ lm(ng), mm(ng) /), &
1645 & deblocklist=deblocklist, &
1646 & rc=rc)
1647 IF (esmf_logfounderror(rctocheck=rc, &
1648 & msg=esmf_logerr_passthru, &
1649 & line=__line__, &
1650 & file=myfile)) THEN
1651 RETURN
1652 END IF
1653!
1654! Report ROMS DistGrid based on model domain decomposition.
1655!
1656 IF ((tile.eq.0).and.(debuglevel.gt.0)) THEN
1657 WRITE (cplout,10) ng, trim(gridtype(icenter))//" Point", &
1658 & ntilei(ng), ntilej(ng)
1659 DO mytile=1,ntilei(ng)*ntilej(ng)
1660 WRITE (cplout,20) mytile-1, deblocklist(1,1,mytile), &
1661 & deblocklist(1,2,mytile), &
1662 & deblocklist(2,1,mytile), &
1663 & deblocklist(2,2,mytile)
1664 END DO
1665 END IF
1666 IF (allocated(deblocklist)) deallocate (deblocklist)
1667!
1668!-----------------------------------------------------------------------
1669! Set component grid coordinates.
1670!-----------------------------------------------------------------------
1671!
1672! Define component grid location type: Arakawa C-grid.
1673!
1674! Icenter: RHO-point, cell center
1675! Icorner: PSI-point, cell corners
1676! Iupoint: U-point, cell west/east sides
1677! Ivpoint: V-point, cell south/north sides
1678!
1679 IF (.not.allocated(models(iroms)%mesh)) THEN
1680 allocate ( models(iroms)%mesh(4) )
1681 models(iroms)%mesh(1)%gtype=icenter
1682 models(iroms)%mesh(2)%gtype=icorner
1683 models(iroms)%mesh(3)%gtype=iupoint
1684 models(iroms)%mesh(4)%gtype=ivpoint
1685 END IF
1686!
1687! Create ESMF Grid. The array indices are global following ROMS
1688! design.
1689!
1690 models(iroms)%grid(ng)=esmf_gridcreate(distgrid=distgrid, &
1691 & gridedgelwidth=(/2,2/), &
1692 & gridedgeuwidth=(/2,2/), &
1693 & indexflag=esmf_index_global, &
1694 & name=trim(models(iroms)%name), &
1695 & rc=rc)
1696 IF (esmf_logfounderror(rctocheck=rc, &
1697 & msg=esmf_logerr_passthru, &
1698 & line=__line__, &
1699 & file=myfile)) THEN
1700 RETURN
1701 END IF
1702!
1703! Get number of local decomposition elements (DEs). Usually, a single
1704! DE is associated with each Persistent Execution Thread (PETs). Thus,
1705! localDEcount=1.
1706!
1707 CALL esmf_gridget (models(iroms)%grid(ng), &
1708 & localdecount=localdecount, &
1709 & rc=rc)
1710 IF (esmf_logfounderror(rctocheck=rc, &
1711 & msg=esmf_logerr_passthru, &
1712 & line=__line__, &
1713 & file=myfile)) THEN
1714 RETURN
1715 END IF
1716!
1717! Mesh coordinates for each variable type.
1718!
1719 mesh_loop : DO ivar=1,ubound(models(iroms)%mesh, dim=1)
1720!
1721! Set staggering type, Arakawa C-grid.
1722!
1723 SELECT CASE (models(iroms)%mesh(ivar)%gtype)
1724 CASE (icenter)
1725 staggerloc=esmf_staggerloc_center
1726 staggeredgelwidth=(/1,1/)
1727 staggeredgeuwidth=(/1,1/)
1728 CASE (icorner)
1729 staggerloc=esmf_staggerloc_corner
1730 staggeredgelwidth=(/1,1/)
1731 staggeredgeuwidth=(/2,2/)
1732 CASE (iupoint)
1733 staggerloc=esmf_staggerloc_edge1
1734 staggeredgelwidth=(/1,1/)
1735 staggeredgeuwidth=(/2,1/)
1736 CASE (ivpoint)
1737 staggerloc=esmf_staggerloc_edge2
1738 staggeredgelwidth=(/1,1/)
1739 staggeredgeuwidth=(/1,2/)
1740 END SELECT
1741!
1742! Allocate coordinate storage associated with staggered grid type.
1743! No coordinate values are set yet.
1744!
1745 CALL esmf_gridaddcoord (models(iroms)%grid(ng), &
1746 & staggerloc=staggerloc, &
1747 & staggeredgelwidth=staggeredgelwidth, &
1748 & staggeredgeuwidth=staggeredgeuwidth, &
1749 & rc=rc)
1750 IF (esmf_logfounderror(rctocheck=rc, &
1751 & msg=esmf_logerr_passthru, &
1752 & line=__line__, &
1753 & file=myfile)) THEN
1754 RETURN
1755 END IF
1756
1757# ifdef MASKING
1758!
1759! Allocate storage for land/sea masking.
1760!
1761 CALL esmf_gridadditem (models(iroms)%grid(ng), &
1762 & staggerloc=staggerloc, &
1763 & itemflag=esmf_griditem_mask, &
1764 & rc=rc)
1765 IF (esmf_logfounderror(rctocheck=rc, &
1766 & msg=esmf_logerr_passthru, &
1767 & line=__line__, &
1768 & file=myfile)) THEN
1769 RETURN
1770 END IF
1771 models(iroms)%LandValue=0
1772 models(iroms)%SeaValue=1
1773# endif
1774!
1775! Allocate storage for grid area.
1776!
1777 CALL esmf_gridadditem (models(iroms)%grid(ng), &
1778 & staggerloc=staggerloc, &
1779 & itemflag=esmf_griditem_area, &
1780 & rc=rc)
1781 IF (esmf_logfounderror(rctocheck=rc, &
1782 & msg=esmf_logerr_passthru, &
1783 & line=__line__, &
1784 & file=myfile)) THEN
1785 RETURN
1786 END IF
1787!
1788! Get pointers and set coordinates for the grid. Usually, the DO-loop
1789! is executed once since localDEcount=1.
1790!
1791 de_loop : DO localde=0,localdecount-1
1792 CALL esmf_gridgetcoord (models(iroms)%grid(ng), &
1793 & coorddim=1, &
1794 & localde=localde, &
1795 & staggerloc=staggerloc, &
1796 & farrayptr=ptrx, &
1797 & rc=rc)
1798 IF (esmf_logfounderror(rctocheck=rc, &
1799 & msg=esmf_logerr_passthru, &
1800 & line=__line__, &
1801 & file=myfile)) THEN
1802 RETURN
1803 END IF
1804!
1805 CALL esmf_gridgetcoord (models(iroms)%grid(ng), &
1806 & coorddim=2, &
1807 & localde=localde, &
1808 & staggerloc=staggerloc, &
1809 & farrayptr=ptry, &
1810 & rc=rc)
1811 IF (esmf_logfounderror(rctocheck=rc, &
1812 & msg=esmf_logerr_passthru, &
1813 & line=__line__, &
1814 & file=myfile)) THEN
1815 RETURN
1816 END IF
1817!
1818 CALL esmf_gridgetitem (models(iroms)%grid(ng), &
1819 & localde=localde, &
1820 & staggerloc=staggerloc, &
1821 & itemflag=esmf_griditem_mask, &
1822 & farrayptr=ptrm, &
1823 & rc=rc)
1824 IF (esmf_logfounderror(rctocheck=rc, &
1825 & msg=esmf_logerr_passthru, &
1826 & line=__line__, &
1827 & file=myfile)) THEN
1828 RETURN
1829 END IF
1830!
1831 CALL esmf_gridgetitem (models(iroms)%grid(ng), &
1832 & localde=localde, &
1833 & staggerloc=staggerloc, &
1834 & itemflag=esmf_griditem_area, &
1835 & farrayptr=ptra, &
1836 & rc=rc)
1837 IF (esmf_logfounderror(rctocheck=rc, &
1838 & msg=esmf_logerr_passthru, &
1839 & line=__line__, &
1840 & file=myfile)) THEN
1841 RETURN
1842 END IF
1843!
1844! Fill grid pointers.
1845!
1846 SELECT CASE (models(iroms)%mesh(ivar)%gtype)
1847! U-points
1848 CASE (icenter)
1849 DO j=jstrr,jendr
1850 DO i=istrr,iendr
1851 ptrx(i,j)=grid(ng)%lonr(i,j)
1852 ptry(i,j)=grid(ng)%latr(i,j)
1853# ifdef MASKING
1854 ptrm(i,j)=int(grid(ng)%rmask(i,j))
1855# else
1856 ptrm(i,j)=1
1857# endif
1858 ptra(i,j)=grid(ng)%om_r(i,j)*grid(ng)%on_r(i,j)
1859 END DO
1860 END DO
1861! PSI-points
1862 CASE (icorner)
1863 DO j=jstrr,jendr
1864 DO i=istrr,iendr
1865 ptrx(i,j)=grid(ng)%lonp(i,j)
1866 ptry(i,j)=grid(ng)%latp(i,j)
1867# ifdef MASKING
1868 ptrm(i,j)=int(grid(ng)%pmask(i,j))
1869# else
1870 ptrm(i,j)=1
1871# endif
1872 ptra(i,j)=grid(ng)%om_p(i,j)*grid(ng)%on_p(i,j)
1873 END DO
1874 END DO
1875! Extrapolate PSI-points at bottom edge
1876!
1877 IF (tile.lt.ntilei(ng)) THEN
1878 ptrx(:,jstr-1)=2.0_dp*ptrx(:,jstr)-ptrx(:,jstr+1)
1879 ptry(:,jstr-1)=2.0_dp*ptry(:,jstr)-ptry(:,jstr+1)
1880 ptrm(:,jstr-1)=ptrm(:,jstr)
1881 ptra(:,jstr-1)=ptra(:,jstr)
1882 END IF
1883! Extrapolate PSI-points at left edge
1884!
1885 IF (mod(tile,ntilei(ng)).eq.0) THEN
1886 ptrx(istr-1,:)=2.0_dp*ptrx(istr,:)-ptrx(istr+1,:)
1887 ptry(istr-1,:)=2.0_dp*ptry(istr,:)-ptry(istr+1,:)
1888 ptrm(istr-1,:)=ptrm(istr,:)
1889 ptra(istr-1,:)=ptra(istr,:)
1890 END IF
1891! Extrapolate PSI-points at top edge
1892!
1893 IF (tile.ge.(ntilei(ng)*(ntilej(ng)-1))) THEN
1894 ptrx(:,jend+2)=2.0_dp*ptrx(:,jend+1)-ptrx(:,jend)
1895 ptry(:,jend+2)=2.0_dp*ptry(:,jend+1)-ptry(:,jend)
1896 ptrm(:,jend+2)=ptrm(:,jend+1)
1897 ptra(:,jend+2)=ptra(:,jend+1)
1898 END IF
1899! Extrapolate PSI-points at right edge
1900!
1901 IF (mod(tile+1,ntilei(ng)).eq.0) THEN
1902 ptrx(iend+2,:)=2.0_dp*ptrx(iend+1,:)-ptrx(iend,:)
1903 ptry(iend+2,:)=2.0_dp*ptry(iend+1,:)-ptry(iend,:)
1904 ptrm(iend+2,:)=ptrm(iend+1,:)
1905 ptra(iend+2,:)=ptra(iend+1,:)
1906 END IF
1907! U-points
1908 CASE (iupoint)
1909 DO j=jstrr,jendr
1910 DO i=istr,iendr
1911 ptrx(i,j)=grid(ng)%lonu(i,j)
1912 ptry(i,j)=grid(ng)%latu(i,j)
1913# ifdef MASKING
1914 ptrm(i,j)=int(grid(ng)%umask(i,j))
1915# else
1916 ptrm(i,j)=1
1917# endif
1918 ptra(i,j)=grid(ng)%om_u(i,j)*grid(ng)%on_u(i,j)
1919 END DO
1920 END DO
1921! Extrapolate U-points at left edge
1922!
1923 IF (mod(tile,ntilei(ng)).eq.0) THEN
1924 ptrx(istr-1,:)=2.0_dp*ptrx(istr,:)-ptrx(istr+1,:)
1925 ptry(istr-1,:)=2.0_dp*ptry(istr,:)-ptry(istr+1,:)
1926 ptrm(istr-1,:)=ptrm(istr,:)
1927 ptra(istr-1,:)=ptra(istr,:)
1928 END IF
1929! Extrapolate U-points at right edge
1930!
1931 IF (mod(tile+1,ntilei(ng)).eq.0) THEN
1932 ptrx(iend+2,:)=2.0_dp*ptrx(iend+1,:)-ptrx(iend,:)
1933 ptry(iend+2,:)=2.0_dp*ptry(iend+1,:)-ptry(iend,:)
1934 ptrm(iend+2,:)=ptrm(iend+1,:)
1935 ptra(iend+2,:)=ptra(iend+1,:)
1936 END IF
1937! V-points
1938 CASE (ivpoint)
1939 DO j=jstr,jendr
1940 DO i=istrr,iendr
1941 ptrx(i,j)=grid(ng)%lonv(i,j)
1942 ptry(i,j)=grid(ng)%latv(i,j)
1943# ifdef MASKING
1944 ptrm(i,j)=int(grid(ng)%vmask(i,j))
1945# else
1946 ptrm(i,j)=1
1947# endif
1948 ptra(i,j)=grid(ng)%om_v(i,j)*grid(ng)%on_v(i,j)
1949 END DO
1950 END DO
1951! Extrapolate V-points at bottom edge
1952!
1953 IF (tile.lt.ntilei(ng)) THEN
1954 ptrx(:,jstr-1)=2.0_dp*ptrx(:,jstr)-ptrx(:,jstr+1)
1955 ptry(:,jstr-1)=2.0_dp*ptry(:,jstr)-ptry(:,jstr+1)
1956 ptrm(:,jstr-1)=ptrm(:,jstr)
1957 ptra(:,jstr-1)=ptra(:,jstr)
1958 END IF
1959! Extrapolate V-points at top edge
1960!
1961 IF (tile.ge.(ntilei(ng)*(ntilej(ng)-1))) THEN
1962 ptrx(:,jend+2)=2.0_dp*ptrx(:,jend+1)-ptrx(:,jend)
1963 ptry(:,jend+2)=2.0_dp*ptry(:,jend+1)-ptry(:,jend)
1964 ptrm(:,jend+2)=ptrm(:,jend+1)
1965 ptra(:,jend+2)=ptra(:,jend+1)
1966 END IF
1967 END SELECT
1968!
1969! Nullify pointers.
1970!
1971 IF ( associated(ptrx) ) nullify (ptrx)
1972 IF ( associated(ptry) ) nullify (ptry)
1973 IF ( associated(ptrm) ) nullify (ptrm)
1974 IF ( associated(ptra) ) nullify (ptra)
1975 END DO de_loop
1976!
1977! Debugging: write out component grid in VTK format.
1978!
1979 IF (debuglevel.ge.4) THEN
1980 gtype=models(iroms)%mesh(ivar)%gtype
1981 CALL esmf_gridwritevtk (models(iroms)%grid(ng), &
1982 & filename="roms_"// &
1983 & trim(gridtype(gtype))// &
1984 & "_point", &
1985 & staggerloc=staggerloc, &
1986 & rc=rc)
1987 IF (esmf_logfounderror(rctocheck=rc, &
1988 & msg=esmf_logerr_passthru, &
1989 & line=__line__, &
1990 & file=myfile)) THEN
1991 RETURN
1992 END IF
1993 END IF
1994 END DO mesh_loop
1995!
1996! Assign grid to gridded component.
1997!
1998 CALL esmf_gridcompset (model, &
1999 & grid=models(iroms)%grid(ng), &
2000 & rc=rc)
2001 IF (esmf_logfounderror(rctocheck=rc, &
2002 & msg=esmf_logerr_passthru, &
2003 & line=__line__, &
2004 & file=myfile)) THEN
2005 RETURN
2006 END IF
2007!
2008 IF (esm_track) THEN
2009 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetGridArrays', &
2010 & ', PET', petrank
2011 FLUSH (trac)
2012 END IF
2013 IF (debuglevel.gt.0) FLUSH (cplout)
2014!
2015 10 FORMAT (/,'ROMS Domain Decomposition:',/,25('='),/, &
2016 /,2x,'ROMS_DistGrid - Grid = ',i2.2,',',3x,'Mesh = ',a, &
2017 & ',',3x,'Partition = ',i0,' x ',i0)
2018 20 FORMAT (18x,'node = ',i0,t32,'Istr = ',i0,t45,'Iend = ',i0, &
2019 & t58,'Jstr = ',i0,t71,'Jend = ',i0)
2020!
2021 RETURN

References mod_param::bounds, mod_esmf_esm::cplout, mod_esmf_esm::debuglevel, mod_esmf_esm::esm_track, mod_grid::grid, mod_esmf_esm::gridtype, mod_esmf_esm::icenter, mod_esmf_esm::icorner, mod_esmf_esm::iroms, mod_esmf_esm::iupoint, mod_esmf_esm::ivpoint, mod_param::lm, mod_param::mm, mod_esmf_esm::models, mod_param::ntilei, mod_param::ntilej, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by roms_setinitializep2().

Here is the caller graph for this function:

◆ roms_setinitializep1()

subroutine, private esmf_roms_mod::roms_setinitializep1 ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 353 of file esmf_roms.h.

356!
357!=======================================================================
358! !
359! ROMS component Phase 1 initialization: sets import and export !
360! fields long and short names into its respective state. !
361! !
362!=======================================================================
363!
364! Imported variable declarations.
365!
366 integer, intent(out) :: rc
367!
368 TYPE (ESMF_GridComp) :: model
369 TYPE (ESMF_State) :: ImportState
370 TYPE (ESMF_State) :: ExportState
371 TYPE (ESMF_Clock) :: clock
372!
373! Local variable declarations.
374!
375 integer :: i, ng, localPET
376!
377 character (len=100) :: CoupledSet, StateLabel
378 character (len=240) :: StandardName, ShortName
379
380 character (len=*), parameter :: MyFile = &
381 & __FILE__//", ROMS_SetInitializeP1"
382!
383!-----------------------------------------------------------------------
384! Initialize return code flag to success state (no error).
385!-----------------------------------------------------------------------
386!
387 IF (esm_track) THEN
388 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetInitializeP1', &
389 & ', PET', petrank
390 FLUSH (trac)
391 END IF
392 rc=esmf_success
393!
394!-----------------------------------------------------------------------
395! Querry the Virtual Machine (VM) parallel environmemt for the MPI
396! current node rank.
397!-----------------------------------------------------------------------
398!
399 CALL esmf_gridcompget (model, &
400 & localpet=localpet, &
401 & rc=rc)
402 IF (esmf_logfounderror(rctocheck=rc, &
403 & msg=esmf_logerr_passthru, &
404 & line=__line__, &
405 & file=myfile)) THEN
406 RETURN
407 END IF
408!
409!-----------------------------------------------------------------------
410! Set ROMS Import State metadata.
411!-----------------------------------------------------------------------
412!
413! Add ROMS import state(s). If nesting, each grid has its own import
414! state.
415!
416 importing : IF (nimport(iroms).gt.0) THEN
417 DO ng=1,models(iroms)%Ngrids
418 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
419 coupledset=trim(coupled(iroms)%SetLabel(ng))
420 statelabel=trim(coupled(iroms)%ImpLabel(ng))
421 CALL nuopc_addnestedstate (importstate, &
422 & cplset=trim(coupledset), &
423 & nestedstatename=trim(statelabel),&
424 & nestedstate=models(iroms)% &
425 & importstate(ng), &
426 rc=rc)
427 IF (esmf_logfounderror(rctocheck=rc, &
428 & msg=esmf_logerr_passthru, &
429 & line=__line__, &
430 & file=myfile)) THEN
431 RETURN
432 END IF
433 IF (localpet.eq.0) THEN
434 WRITE (cplout,10) 'ROMS adding Import Nested State: ', &
435 & trim(statelabel), ng
436 END IF
437!
438! Add fields import state.
439!
440 DO i=1,nimport(iroms)
441 standardname=models(iroms)%ImportField(i)%standard_name
442 shortname =models(iroms)%ImportField(i)%short_name
443 IF (localpet.eq.0) THEN
444 WRITE (cplout,20) 'Advertising Import Field: ', &
445 & trim(shortname), trim(standardname)
446 END IF
447 CALL nuopc_advertise (models(iroms)%ImportState(ng), &
448 & standardname=trim(standardname), &
449 & name=trim(shortname), &
450 & rc=rc)
451 IF (esmf_logfounderror(rctocheck=rc, &
452 & msg=esmf_logerr_passthru, &
453 & line=__line__, &
454 & file=myfile)) THEN
455 RETURN
456 END IF
457
458# ifdef LONGWAVE_OUT
459!
460 IF (trim(shortname).eq.'LWrad') THEN
461 rc=esmf_rc_not_valid
462 IF (localpet.eq.0) THEN
463 WRITE (cplout,30) trim(shortname), 'LONGWAVE_OUT', &
464 & 'downward longwave radiation: dLWrad', &
465 & 'LONGWAVE_OUT'
466 END IF
467 IF (esmf_logfounderror(rctocheck=rc, &
468 & msg=esmf_logerr_passthru, &
469 & line=__line__, &
470 & file=myfile)) THEN
471 RETURN
472 END IF
473 END IF
474# endif
475 END DO
476 END IF
477 END DO
478 END IF importing
479!
480!-----------------------------------------------------------------------
481! Set ROMS Export State metadata.
482!-----------------------------------------------------------------------
483!
484! Add ROMS export state. If nesting, each grid has its own export
485! state.
486!
487 exporting : IF (nexport(iroms).gt.0) THEN
488 DO ng=1,models(iroms)%Ngrids
489 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
490 coupledset=trim(coupled(iroms)%SetLabel(ng))
491 statelabel=trim(coupled(iroms)%ExpLabel(ng))
492 CALL nuopc_addnestedstate (exportstate, &
493 & cplset=trim(coupledset), &
494 & nestedstatename=trim(statelabel),&
495 & nestedstate=models(iroms)% &
496 & exportstate(ng), &
497 rc=rc)
498 IF (esmf_logfounderror(rctocheck=rc, &
499 & msg=esmf_logerr_passthru, &
500 & line=__line__, &
501 & file=myfile)) THEN
502 RETURN
503 END IF
504 IF (localpet.eq.0) THEN
505 WRITE (cplout,10) 'ROMS adding Export Nested State: ', &
506 & trim(statelabel), ng
507 END IF
508!
509! Add fields to export state.
510!
511 DO i=1,nexport(iroms)
512 standardname=models(iroms)%ExportField(i)%standard_name
513 shortname =models(iroms)%ExportField(i)%short_name
514 IF (localpet.eq.0) THEN
515 WRITE (cplout,20) 'Advertising Export Field: ', &
516 & trim(shortname), trim(standardname)
517 END IF
518 CALL nuopc_advertise (models(iroms)%ExportState(ng), &
519 & standardname=trim(standardname), &
520 & name=trim(shortname), &
521 & rc=rc)
522 IF (esmf_logfounderror(rctocheck=rc, &
523 & msg=esmf_logerr_passthru, &
524 & line=__line__, &
525 & file=myfile)) THEN
526 RETURN
527 END IF
528 END DO
529 END IF
530 END DO
531 END IF exporting
532!
533 IF (esm_track) THEN
534 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetInitializeP1', &
535 & ', PET', petrank
536 FLUSH (trac)
537 END IF
538!
539 10 FORMAT (/,a,a,', ng = ',i0,/,31('='),/)
540 20 FORMAT (2x,a,"'",a,"'",t45,a)
541# ifdef LONGWAVE_OUT
542 30 FORMAT (/,' ROMS_SetInitializeP1 - incorrect field to process: ', &
543 & a,/,24x,'when activating option: ',a,/,24x, &
544 & 'use instead ',a,/,24x,'or deactivate option: ',a,/)
545# endif
546!
547 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_esmf_esm::esm_track, mod_esmf_esm::iroms, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::nimport, mod_esmf_esm::petrank, strings_mod::standardname(), and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_setinitializep2()

subroutine, private esmf_roms_mod::roms_setinitializep2 ( type (esmf_gridcomp) model,
type (esmf_state) importstate,
type (esmf_state) exportstate,
type (esmf_clock) clock,
integer, intent(out) rc )
private

Definition at line 550 of file esmf_roms.h.

553!
554!=======================================================================
555! !
556! ROMS component Phase 2 initialization: Initializes ROMS, sets !
557! component grid, and adds import and export fields to respective !
558! states. !
559! !
560!=======================================================================
561!
562! Imported variable declarations.
563!
564 integer, intent(out) :: rc
565!
566 TYPE (ESMF_GridComp) :: model
567 TYPE (ESMF_State) :: ImportState
568 TYPE (ESMF_State) :: ExportState
569 TYPE (ESMF_Clock) :: clock
570!
571! Local variable declarations.
572!
573 logical, save :: first
574!
575 integer :: LBi, UBi, LBj, UBj
576 integer :: MyComm
577 integer :: ng, localPET, PETcount, tile
578!
579 real (dp) :: driverDuration, romsDuration
580!
581 character (len=*), parameter :: MyFile = &
582 & __FILE__//", ROMS_SetInitializeP2"
583!
584 TYPE (ESMF_TimeInterval) :: RunDuration, TimeStep
585 TYPE (ESMF_Time) :: CurrTime, startTime
586 TYPE (ESMF_VM) :: vm
587!
588!-----------------------------------------------------------------------
589! Initialize return code flag to success state (no error).
590!-----------------------------------------------------------------------
591!
592 IF (esm_track) THEN
593 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetInitializeP2', &
594 & ', PET', petrank
595 FLUSH (trac)
596 END IF
597 rc=esmf_success
598!
599!-----------------------------------------------------------------------
600! Query the Virtual Machine (VM) parallel environmemt for the MPI
601! communicator handle and current node rank.
602!-----------------------------------------------------------------------
603!
604 CALL esmf_gridcompget (model, &
605 & vm=vm, &
606 & rc=rc)
607 IF (esmf_logfounderror(rctocheck=rc, &
608 & msg=esmf_logerr_passthru, &
609 & line=__line__, &
610 & file=myfile)) THEN
611 RETURN
612 END IF
613!
614 CALL esmf_vmget (vm, &
615 & localpet=localpet, &
616 & petcount=petcount, &
617 & mpicommunicator=mycomm, &
618 & rc=rc)
619 IF (esmf_logfounderror(rctocheck=rc, &
620 & msg=esmf_logerr_passthru, &
621 & line=__line__, &
622 & file=myfile)) THEN
623 RETURN
624 END IF
625 tile=localpet
626 esmcomm(iroms)=mycomm
627!
628!-----------------------------------------------------------------------
629! Initialize ROMS component. In nested applications, ROMS kernel will
630! allocate and initialize all grids with a single call to
631! "ROMS_initialize".
632!-----------------------------------------------------------------------
633!
634 first=.true.
635 CALL roms_initialize (first, mpicomm=mycomm)
636 IF (exit_flag.ne.noerror) THEN
637 rc=esmf_rc_obj_init
638 IF (esmf_logfounderror(rctocheck=rc, &
639 & msg=esmf_logerr_passthru, &
640 & line=__line__, &
641 & file=myfile)) THEN
642 RETURN
643 END IF
644 END IF
645
646# ifdef TIME_INTERP
647!
648!-----------------------------------------------------------------------
649! Create field time interpolation variable attributes NetCDF file. It
650! needs to be done after ROMS initialization since the NetCDF and
651! mpi interface use several variables from ROMS profiling that need
652! to be allocated.
653!-----------------------------------------------------------------------
654!
655 IF (petlayoutoption.eq.'CONCURRENT') THEN
656 CALL def_fieldatt (vm, rc)
657 IF (esmf_logfounderror(rctocheck=rc, &
658 & msg=esmf_logerr_passthru, &
659 & line=__line__, &
660 & file=myfile)) THEN
661 RETURN
662 END IF
663 END IF
664# endif
665!
666!-----------------------------------------------------------------------
667! Check ROMS simulation length and compare with that of the coupling
668! driver. We need to use the driver clock here since the ROMS
669! component clock has been not created before this intialization
670! phase.
671!-----------------------------------------------------------------------
672!
673 IF (models(iroms)%IsActive) THEN
674 CALL esmf_clockget (clockinfo(idriver)%Clock, &
675 & currtime=currtime, &
676 & timestep=timestep, &
677 & runduration=runduration, &
678 & rc=rc)
679 IF (esmf_logfounderror(rctocheck=rc, &
680 & msg=esmf_logerr_passthru, &
681 & line=__line__, &
682 & file=myfile)) THEN
683 RETURN
684 END IF
685!
686# ifdef REGRESS_STARTCLOCK
687 CALL esmf_timeintervalget (runduration-timestep, &
688 & s_r8=driverduration, &
689 & rc=rc)
690 IF (esmf_logfounderror(rctocheck=rc, &
691 & msg=esmf_logerr_passthru, &
692 & line=__line__, &
693 & file=myfile)) THEN
694 RETURN
695 END IF
696# else
697 CALL esmf_timeintervalget (runduration, &
698 & s_r8=driverduration, &
699 & rc=rc)
700 IF (esmf_logfounderror(rctocheck=rc, &
701 & msg=esmf_logerr_passthru, &
702 & line=__line__, &
703 & file=myfile)) THEN
704 RETURN
705 END IF
706# endif
707!
708 DO ng=1,models(iroms)%Ngrids
709 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
710 romsduration=(ntend(ng)-ntfirst(ng)+1)*dt(ng)
711 IF (romsduration.ne.driverduration) THEN
712 IF (localpet.eq.0) THEN
713 WRITE (cplout,10) romsduration, driverduration, &
714 & trim(inpname(iroms))
715 END IF
716 rc=esmf_rc_not_valid
717 RETURN
718 END IF
719 END IF
720 END DO
721 END IF
722!
723!-----------------------------------------------------------------------
724! Set-up grid and load coordinate data.
725!-----------------------------------------------------------------------
726!
727 DO ng=1,models(iroms)%Ngrids
728 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
729 CALL roms_setgridarrays (ng, tile, model, rc)
730 IF (esmf_logfounderror(rctocheck=rc, &
731 & msg=esmf_logerr_passthru, &
732 & line=__line__, &
733 & file=myfile)) THEN
734 RETURN
735 END IF
736 END IF
737 END DO
738!
739!-----------------------------------------------------------------------
740! Set-up fields and register to import/export states.
741!-----------------------------------------------------------------------
742!
743 DO ng=1,models(iroms)%Ngrids
744 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
745 CALL roms_setstates (ng, tile, model, rc)
746 IF (esmf_logfounderror(rctocheck=rc, &
747 & msg=esmf_logerr_passthru, &
748 & line=__line__, &
749 & file=myfile)) THEN
750 RETURN
751 END IF
752 END IF
753 END DO
754!
755 IF (esm_track) THEN
756 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetInitializeP2', &
757 & ', PET', petrank
758 FLUSH (trac)
759 END IF
760!
761 10 FORMAT (/,' ROMS_SetInitializeP2 - inconsitent configuration ', &
762 & 'run duration',/,24x, &
763 & 'ROMS Duration = ',f20.2,' seconds',/,24x, &
764 & 'Coupling Duration = ',f20.2,' seconds',/,24x, &
765 & 'Check paramenter NTIMES in ''',a,'''',a)
766!
767 RETURN

References mod_esmf_esm::clockinfo, mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_esmf_esm::def_fieldatt(), mod_scalars::dt, mod_esmf_esm::esm_track, mod_esmf_esm::esmcomm, mod_scalars::exit_flag, mod_esmf_esm::idriver, mod_esmf_esm::inpname, mod_esmf_esm::iroms, mod_esmf_esm::models, mod_scalars::noerror, mod_scalars::ntend, mod_scalars::ntfirst, mod_esmf_esm::petlayoutoption, mod_esmf_esm::petrank, roms_kernel_mod::roms_initialize(), roms_setgridarrays(), roms_setstates(), mod_esmf_esm::timestep, and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ roms_setrunclock()

subroutine, private esmf_roms_mod::roms_setrunclock ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 1204 of file esmf_roms.h.

1205!
1206!=======================================================================
1207! !
1208! Sets ROMS run clock manually to avoid getting zero time stamps at !
1209! the first regridding call. !
1210! !
1211!=======================================================================
1212!
1213! Imported variable declarations.
1214!
1215 integer, intent(out) :: rc
1216!
1217 TYPE (ESMF_GridComp) :: model
1218!
1219! Local variable declarations.
1220!
1221 character (len=*), parameter :: MyFile = &
1222 & __FILE__//", ROMS_SetRunClock"
1223!
1224 TYPE (ESMF_Clock) :: driverClock, modelClock
1225 TYPE (ESMF_Time) :: currTime
1226!
1227!-----------------------------------------------------------------------
1228! Initialize return code flag to success state (no error).
1229!-----------------------------------------------------------------------
1230!
1231 IF (esm_track) THEN
1232 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetRunClock', &
1233 & ', PET', petrank
1234 FLUSH (trac)
1235 END IF
1236 rc=esmf_success
1237!
1238!-----------------------------------------------------------------------
1239! Set ROMS run clock manually.
1240!-----------------------------------------------------------------------
1241!
1242! Inquire driver and model clock.
1243!
1244 CALL nuopc_modelget (model, &
1245 & driverclock=driverclock, &
1246 & modelclock=modelclock, &
1247 & rc=rc)
1248 IF (esmf_logfounderror(rctocheck=rc, &
1249 & msg=esmf_logerr_passthru, &
1250 & line=__line__, &
1251 & file=myfile)) THEN
1252 RETURN
1253 END IF
1254!
1255! Set model clock to have the current start time as the driver clock.
1256!
1257 CALL esmf_clockget (driverclock, &
1258 & currtime=currtime, &
1259 & rc=rc)
1260 IF (esmf_logfounderror(rctocheck=rc, &
1261 & msg=esmf_logerr_passthru, &
1262 & line=__line__, &
1263 & file=myfile)) THEN
1264 RETURN
1265 END IF
1266!
1267 CALL esmf_clockset (modelclock, &
1268 & currtime=currtime, &
1269 & rc=rc)
1270 IF (esmf_logfounderror(rctocheck=rc, &
1271 & msg=esmf_logerr_passthru, &
1272 & line=__line__, &
1273 & file=myfile)) THEN
1274 RETURN
1275 END IF
1276!
1277! Check and set the component clock against the driver clock.
1278!
1279 CALL nuopc_compchecksetclock (model, &
1280 & driverclock, &
1281 & rc=rc)
1282 IF (esmf_logfounderror(rctocheck=rc, &
1283 & msg=esmf_logerr_passthru, &
1284 & line=__line__, &
1285 & file=myfile)) THEN
1286 RETURN
1287 END IF
1288!
1289 IF (esm_track) THEN
1290 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetRunClock', &
1291 & ', PET', petrank
1292 FLUSH (trac)
1293 END IF
1294!
1295 RETURN

References mod_esmf_esm::esm_track, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by roms_setservices().

Here is the caller graph for this function:

◆ roms_setservices()

subroutine, public esmf_roms_mod::roms_setservices ( type (esmf_gridcomp) model,
integer, intent(out) rc )

Definition at line 168 of file esmf_roms.h.

169!
170!=======================================================================
171! !
172! Sets ROMS component shared-object entry points for "initialize", !
173! "run", and "finalize" by using NUOPC generic methods. !
174! !
175!=======================================================================
176!
177! Imported variable declarations.
178!
179 integer, intent(out) :: rc
180!
181 TYPE (ESMF_GridComp) :: model
182!
183! Local variable declarations.
184!
185 character (len=*), parameter :: MyFile = &
186 & __FILE__//", ROMS_SetServices"
187!
188!-----------------------------------------------------------------------
189! Initialize return code flag to success state (no error).
190!-----------------------------------------------------------------------
191!
192 IF (esm_track) THEN
193 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetServices', &
194 & ', PET', petrank
195 FLUSH (trac)
196 END IF
197 rc=esmf_success
198!
199!-----------------------------------------------------------------------
200! Register NUOPC generic routines.
201!-----------------------------------------------------------------------
202!
203 CALL nuopc_compderive (model, &
204 & nuopc_setservices, &
205 & rc=rc)
206 IF (esmf_logfounderror(rctocheck=rc, &
207 & msg=esmf_logerr_passthru, &
208 & line=__line__, &
209 & file=myfile)) THEN
210 RETURN
211 END IF
212!
213!-----------------------------------------------------------------------
214! Register initialize routines.
215!-----------------------------------------------------------------------
216!
217! Set routine for Phase 1 initialization (import and export fields).
218!
219 CALL nuopc_compsetentrypoint (model, &
220 & methodflag=esmf_method_initialize, &
221 & phaselabellist=(/"IPDv00p1"/), &
222 & userroutine=roms_setinitializep1, &
223 & rc=rc)
224 IF (esmf_logfounderror(rctocheck=rc, &
225 & msg=esmf_logerr_passthru, &
226 & line=__line__, &
227 & file=myfile)) THEN
228 RETURN
229 END IF
230!
231! Set routine for Phase 2 initialization (exchange arrays).
232!
233 CALL nuopc_compsetentrypoint (model, &
234 & methodflag=esmf_method_initialize, &
235 & phaselabellist=(/"IPDv00p2"/), &
236 & userroutine=roms_setinitializep2, &
237 & rc=rc)
238 IF (esmf_logfounderror(rctocheck=rc, &
239 & msg=esmf_logerr_passthru, &
240 & line=__line__, &
241 & file=myfile)) THEN
242 RETURN
243 END IF
244!
245!-----------------------------------------------------------------------
246! Attach ROMS component phase independent specializing methods.
247!-----------------------------------------------------------------------
248!
249! Set routine for export initial/restart fields.
250!
251 CALL nuopc_compspecialize (model, &
252 & speclabel=nuopc_label_datainitialize, &
253 & specroutine=roms_datainit, &
254 & rc=rc)
255 IF (esmf_logfounderror(rctocheck=rc, &
256 & msg=esmf_logerr_passthru, &
257 & line=__line__, &
258 & file=myfile)) THEN
259 RETURN
260 END IF
261!
262! Set routine for setting ROMS clock.
263!
264 CALL nuopc_compspecialize (model, &
265 & speclabel=nuopc_label_setclock, &
266 & specroutine=roms_setclock, &
267 & rc=rc)
268 IF (esmf_logfounderror(rctocheck=rc, &
269 & msg=esmf_logerr_passthru, &
270 & line=__line__, &
271 & file=myfile)) THEN
272 RETURN
273 END IF
274
275# ifdef ESM_SETRUNCLOCK
276!
277! Set routine for setting ROMS run clock manually. First, remove the
278! default.
279!
280 CALL esmf_methodremove (model, &
281 & nuopc_label_setrunclock, &
282 & rc=rc)
283 IF (esmf_logfounderror(rctocheck=rc, &
284 & msg=esmf_logerr_passthru, &
285 & line=__line__, &
286 & file=myfile)) THEN
287 RETURN
288 END IF
289!
290 CALL nuopc_compspecialize (model, &
291 & speclabel=nuopc_label_setrunclock, &
292 & specroutine=roms_setrunclock, &
293 & rc=rc)
294 IF (esmf_logfounderror(rctocheck=rc, &
295 & msg=esmf_logerr_passthru, &
296 & line=__line__, &
297 & file=myfile)) THEN
298 RETURN
299 END IF
300# endif
301!
302! Set routine for checking import state.
303!
304 CALL nuopc_compspecialize (model, &
305 & speclabel=nuopc_label_checkimport, &
306 & specphaselabel="RunPhase1", &
307 & specroutine=roms_checkimport, &
308 & rc=rc)
309 IF (esmf_logfounderror(rctocheck=rc, &
310 & msg=esmf_logerr_passthru, &
311 & line=__line__, &
312 & file=myfile)) THEN
313 RETURN
314 END IF
315!
316! Set routine for time-stepping ROMS component.
317!
318 CALL nuopc_compspecialize (model, &
319 & speclabel=nuopc_label_advance, &
320 & specroutine=roms_modeladvance, &
321 & rc=rc)
322 IF (esmf_logfounderror(rctocheck=rc, &
323 & msg=esmf_logerr_passthru, &
324 & line=__line__, &
325 & file=myfile)) THEN
326 RETURN
327 END IF
328!
329!-----------------------------------------------------------------------
330! Register ROMS finalize routine.
331!-----------------------------------------------------------------------
332!
333 CALL esmf_gridcompsetentrypoint (model, &
334 & methodflag=esmf_method_finalize, &
335 & userroutine=roms_setfinalize, &
336 & rc=rc)
337 IF (esmf_logfounderror(rctocheck=rc, &
338 & msg=esmf_logerr_passthru, &
339 & line=__line__, &
340 & file=myfile)) THEN
341 RETURN
342 END IF
343!
344 IF (esm_track) THEN
345 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetServices', &
346 & ', PET', petrank
347 FLUSH (trac)
348 END IF
349!
350 RETURN

References mod_esmf_esm::esm_track, mod_esmf_esm::petrank, roms_checkimport(), roms_datainit(), roms_modeladvance(), roms_setclock(), roms_setfinalize(), roms_setinitializep1(), roms_setinitializep2(), roms_setrunclock(), and mod_esmf_esm::trac.

Here is the call graph for this function:

◆ roms_setstates()

subroutine, private esmf_roms_mod::roms_setstates ( integer, intent(in) ng,
integer, intent(in) tile,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 2024 of file esmf_roms.h.

2025!
2026!=======================================================================
2027! !
2028! Adds ROMS component export and import fields into its respective !
2029! state. !
2030! !
2031!=======================================================================
2032!
2033! Imported variable declarations.
2034!
2035 integer, intent(in) :: ng, tile
2036 integer, intent(out) :: rc
2037!
2038 TYPE (ESMF_GridComp) :: model
2039!
2040! Local variable declarations.
2041!
2042 integer :: id, ifld
2043 integer :: localDE, localDEcount, localPET
2044 integer :: ExportCount, ImportCount
2045 integer :: staggerEdgeLWidth(2)
2046 integer :: staggerEdgeUWidth(2)
2047!
2048 real (dp), dimension(:,:), pointer :: ptr2d => null()
2049!
2050 character (len=10) :: AttList(1)
2051
2052 character (len=*), parameter :: MyFile = &
2053 & __FILE__//", ROMS_SetStates"
2054!
2055 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
2056 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
2057!
2058 TYPE (ESMF_ArraySpec) :: arraySpec2d
2059 TYPE (ESMF_Field) :: field
2060 TYPE (ESMF_StaggerLoc) :: staggerLoc
2061 TYPE (ESMF_VM) :: vm
2062!
2063!-----------------------------------------------------------------------
2064! Initialize return code flag to success state (no error).
2065!-----------------------------------------------------------------------
2066!
2067 IF (esm_track) THEN
2068 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetStates', &
2069 & ', PET', petrank
2070 FLUSH (trac)
2071 END IF
2072 rc=esmf_success
2073!
2074!-----------------------------------------------------------------------
2075! Query gridded component.
2076!-----------------------------------------------------------------------
2077!
2078! Get import and export states.
2079!
2080 CALL esmf_gridcompget (model, &
2081 & localpet=localpet, &
2082 & vm=vm, &
2083 & rc=rc)
2084 IF (esmf_logfounderror(rctocheck=rc, &
2085 & msg=esmf_logerr_passthru, &
2086 & line=__line__, &
2087 & file=myfile)) THEN
2088 RETURN
2089 END IF
2090!
2091! Get number of local decomposition elements (DEs). Usually, a single
2092! Decomposition Element (DE) is associated with each Persistent
2093! Execution Thread (PETs). Thus, localDEcount=1.
2094!
2095 CALL esmf_gridget (models(iroms)%grid(ng), &
2096 & localdecount=localdecount, &
2097 & rc=rc)
2098 IF (esmf_logfounderror(rctocheck=rc, &
2099 & msg=esmf_logerr_passthru, &
2100 & line=__line__, &
2101 & file=myfile)) THEN
2102 RETURN
2103 END IF
2104!
2105!-----------------------------------------------------------------------
2106! Set a 2D floating-point array descriptor.
2107!-----------------------------------------------------------------------
2108!
2109 CALL esmf_arrayspecset (arrayspec2d, &
2110 & typekind=esmf_typekind_r8, &
2111 & rank=2, &
2112 & rc=rc)
2113 IF (esmf_logfounderror(rctocheck=rc, &
2114 & msg=esmf_logerr_passthru, &
2115 & line=__line__, &
2116 & file=myfile)) THEN
2117 RETURN
2118 END IF
2119!
2120!-----------------------------------------------------------------------
2121! Add export fields into export state.
2122!-----------------------------------------------------------------------
2123!
2124 exporting : IF (nexport(iroms).gt.0) THEN
2125!
2126! Get number of fields to export.
2127!
2128 CALL esmf_stateget (models(iroms)%ExportState(ng), &
2129 & itemcount=exportcount, &
2130 & rc=rc)
2131 IF (esmf_logfounderror(rctocheck=rc, &
2132 & msg=esmf_logerr_passthru, &
2133 & line=__line__, &
2134 & file=myfile)) THEN
2135 RETURN
2136 END IF
2137!
2138! Get a list of export fields names.
2139!
2140 IF (.not.allocated(exportnamelist)) THEN
2141 allocate ( exportnamelist(exportcount) )
2142 END IF
2143 CALL esmf_stateget (models(iroms)%ExportState(ng), &
2144 & itemnamelist=exportnamelist, &
2145 & rc=rc)
2146 IF (esmf_logfounderror(rctocheck=rc, &
2147 & msg=esmf_logerr_passthru, &
2148 & line=__line__, &
2149 & file=myfile)) THEN
2150 RETURN
2151 END IF
2152!
2153! Set export field(s).
2154!
2155 DO ifld=1,exportcount
2156 id=field_index(models(iroms)%ExportField,exportnamelist(ifld))
2157!
2158 IF (nuopc_isconnected(models(iroms)%ExportState(ng), &
2159 & fieldname=trim(exportnamelist(ifld)), &
2160 & rc=rc)) THEN
2161!
2162! Set staggering type.
2163!
2164 SELECT CASE (models(iroms)%ExportField(id)%gtype)
2165 CASE (icenter) ! RHO-points
2166 staggerloc=esmf_staggerloc_center
2167 CASE (icorner) ! PSI-points
2168 staggerloc=esmf_staggerloc_corner
2169 CASE (iupoint) ! U-points
2170 staggerloc=esmf_staggerloc_edge1
2171 CASE (ivpoint) ! V-points
2172 staggerloc=esmf_staggerloc_edge2
2173 END SELECT
2174!
2175! Create 2D field from the Grid and arraySpec.
2176!
2177 field=esmf_fieldcreate(models(iroms)%grid(ng), &
2178 & arrayspec2d, &
2179 & indexflag=esmf_index_global, &
2180 & staggerloc=staggerloc, &
2181 & name=trim(exportnamelist(ifld)), &
2182 & rc=rc)
2183 IF (esmf_logfounderror(rctocheck=rc, &
2184 & msg=esmf_logerr_passthru, &
2185 & line=__line__, &
2186 & file=myfile)) THEN
2187 RETURN
2188 END IF
2189!
2190! Put data into state. Usually, the DO-loop is executed once since
2191! localDEcount=1.
2192!
2193 DO localde=0,localdecount-1
2194!
2195! Get pointer to DE-local memory allocation within field.
2196!
2197 CALL esmf_fieldget (field, &
2198 & localde=localde, &
2199 & farrayptr=ptr2d, &
2200 & rc=rc)
2201 IF (esmf_logfounderror(rctocheck=rc, &
2202 & msg=esmf_logerr_passthru, &
2203 & line=__line__, &
2204 & file=myfile)) THEN
2205 RETURN
2206 END IF
2207!
2208! Initialize pointer.
2209!
2210 ptr2d=missing_dp
2211!
2212! Nullify pointer to make sure that it does not point on a random part
2213! in the memory.
2214!
2215 IF ( associated(ptr2d) ) nullify (ptr2d)
2216 END DO
2217!
2218! Add field export state.
2219!
2220 CALL nuopc_realize (models(iroms)%ExportState(ng), &
2221 & field=field, &
2222 & rc=rc)
2223 IF (esmf_logfounderror(rctocheck=rc, &
2224 & msg=esmf_logerr_passthru, &
2225 & line=__line__, &
2226 & file=myfile)) THEN
2227 RETURN
2228 END IF
2229!
2230! Remove field from export state because it is not connected.
2231!
2232 ELSE
2233 IF (localpet.eq.0) THEN
2234 WRITE (cplout,10) trim(exportnamelist(ifld)), &
2235 & 'Export State: ', &
2236 & trim(coupled(iroms)%ExpLabel(ng))
2237 END IF
2238 CALL esmf_stateremove (models(iroms)%ExportState(ng), &
2239 & (/ trim(exportnamelist(ifld)) /), &
2240 & rc=rc)
2241 IF (esmf_logfounderror(rctocheck=rc, &
2242 & msg=esmf_logerr_passthru, &
2243 & line=__line__, &
2244 & file=myfile)) THEN
2245 RETURN
2246 END IF
2247 END IF
2248 END DO
2249!
2250! Deallocate arrays.
2251!
2252 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
2253!
2254 END IF exporting
2255!
2256!-----------------------------------------------------------------------
2257! Add import fields into import state.
2258!-----------------------------------------------------------------------
2259!
2260 importing : IF (nimport(iroms).gt.0) THEN
2261!
2262! Get number of fields to import.
2263!
2264 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2265 & itemcount=importcount, &
2266 & rc=rc)
2267 IF (esmf_logfounderror(rctocheck=rc, &
2268 & msg=esmf_logerr_passthru, &
2269 & line=__line__, &
2270 & file=myfile)) THEN
2271 RETURN
2272 END IF
2273!
2274! Get a list of import fields names.
2275!
2276 IF (.not.allocated(importnamelist)) THEN
2277 allocate (importnamelist(importcount))
2278 END IF
2279 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2280 & itemnamelist=importnamelist, &
2281 & rc=rc)
2282 IF (esmf_logfounderror(rctocheck=rc, &
2283 & msg=esmf_logerr_passthru, &
2284 & line=__line__, &
2285 & file=myfile)) THEN
2286 RETURN
2287 END IF
2288!
2289! Set import field(s).
2290!
2291 DO ifld=1,importcount
2292 id=field_index(models(iroms)%ImportField,importnamelist(ifld))
2293!
2294 IF (nuopc_isconnected(models(iroms)%ImportState(ng), &
2295 & fieldname=trim(importnamelist(ifld)), &
2296 & rc=rc)) THEN
2297!
2298! Set staggering type.
2299!
2300 SELECT CASE (models(iroms)%ImportField(id)%gtype)
2301 CASE (icenter) ! RHO-points
2302 staggerloc=esmf_staggerloc_center
2303 CASE (icorner) ! PSI-points
2304 staggerloc=esmf_staggerloc_corner
2305 CASE (iupoint) ! U-points
2306 staggerloc=esmf_staggerloc_edge1
2307 CASE (ivpoint) ! V-points
2308 staggerloc=esmf_staggerloc_edge2
2309 END SELECT
2310!
2311! Create 2D field from the Grid, arraySpec, total tile size.
2312! The array indices are global following ROMS design.
2313!
2314 field=esmf_fieldcreate(models(iroms)%grid(ng), &
2315 & arrayspec2d, &
2316 & indexflag=esmf_index_global, &
2317 & staggerloc=staggerloc, &
2318 & name=trim(importnamelist(ifld)), &
2319 & rc=rc)
2320 IF (esmf_logfounderror(rctocheck=rc, &
2321 & msg=esmf_logerr_passthru, &
2322 & line=__line__, &
2323 & file=myfile)) THEN
2324 RETURN
2325 END IF
2326
2327# ifdef TIME_INTERP_NOT
2328!
2329! Create standard Attribute Package for each export field. Then, nest
2330! custom Attribute Package around it.
2331!
2332 CALL esmf_attributeadd (field, &
2333 & convention='ESMF', &
2334 & purpose='General', &
2335 & rc=rc)
2336 IF (esmf_logfounderror(rctocheck=rc, &
2337 & msg=esmf_logerr_passthru, &
2338 & line=__line__, &
2339 & file=myfile)) THEN
2340 RETURN
2341 END IF
2342!
2343 attlist(1)='TimeInterp'
2344 CALL esmf_attributeadd (field, &
2345 & convention='CustomConvention', &
2346 & purpose='General', &
2347!! & purpose='Instance', &
2348 & attrlist=attlist, &
2349 & nestconvention='ESMF', &
2350 & nestpurpose='General', &
2351 & rc=rc)
2352 IF (esmf_logfounderror(rctocheck=rc, &
2353 & msg=esmf_logerr_passthru, &
2354 & line=__line__, &
2355 & file=myfile)) THEN
2356 RETURN
2357 END IF
2358# endif
2359!
2360! Put data into state. Usually, the DO-loop is executed once since
2361! localDEcount=1.
2362!
2363 DO localde=0,localdecount-1
2364!
2365! Get pointer to DE-local memory allocation within field.
2366!
2367 CALL esmf_fieldget (field, &
2368 & localde=localde, &
2369 & farrayptr=ptr2d, &
2370 & rc=rc)
2371 IF (esmf_logfounderror(rctocheck=rc, &
2372 & msg=esmf_logerr_passthru, &
2373 & line=__line__, &
2374 & file=myfile)) THEN
2375 RETURN
2376 END IF
2377!
2378! Initialize pointer.
2379!
2380 ptr2d=missing_dp
2381!
2382! Nullify pointer to make sure that it does not point on a random
2383! part in the memory.
2384!
2385 IF (associated(ptr2d)) nullify (ptr2d)
2386 END DO
2387!
2388! Add field import state.
2389!
2390 CALL nuopc_realize (models(iroms)%ImportState(ng), &
2391 & field=field, &
2392 & rc=rc)
2393 IF (esmf_logfounderror(rctocheck=rc, &
2394 & msg=esmf_logerr_passthru, &
2395 & line=__line__, &
2396 & file=myfile)) THEN
2397 RETURN
2398 END IF
2399!
2400! Remove field from import state because it is not connected.
2401!
2402 ELSE
2403 IF (localpet.eq.0) THEN
2404 WRITE (cplout,10) trim(importnamelist(ifld)), &
2405 & 'Import State: ', &
2406 & trim(coupled(iroms)%ImpLabel(ng))
2407 END IF
2408 CALL esmf_stateremove (models(iroms)%ImportState(ng), &
2409 & (/ trim(importnamelist(ifld)) /), &
2410 & rc=rc)
2411 IF (esmf_logfounderror(rctocheck=rc, &
2412 & msg=esmf_logerr_passthru, &
2413 & line=__line__, &
2414 & file=myfile)) THEN
2415 RETURN
2416 END IF
2417 END IF
2418 END DO
2419!
2420! Deallocate arrays.
2421!
2422 IF (allocated(importnamelist)) deallocate (importnamelist)
2423!
2424 END IF importing
2425!
2426 IF (esm_track) THEN
2427 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetStates', &
2428 & ', PET', petrank
2429 FLUSH (trac)
2430 END IF
2431!
2432 10 FORMAT (1x,'ROMS_SetStates - Removing field ''',a,''' from ',a, &
2433 & '''',a,'''',/,18x,'because it is not connected.')
2434!
2435 RETURN

References mod_esmf_esm::coupled, mod_esmf_esm::cplout, mod_esmf_esm::esm_track, mod_esmf_esm::field_index(), mod_esmf_esm::icenter, mod_esmf_esm::icorner, mod_esmf_esm::iroms, mod_esmf_esm::iupoint, mod_esmf_esm::ivpoint, mod_esmf_esm::missing_dp, mod_esmf_esm::models, mod_esmf_esm::nexport, mod_esmf_esm::nimport, mod_esmf_esm::petrank, and mod_esmf_esm::trac.

Referenced by roms_setinitializep2().

Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ geo2grid

integer, parameter esmf_roms_mod::geo2grid = 0
private

Definition at line 160 of file esmf_roms.h.

160 integer, parameter :: geo2grid = 0 ! U- and V-points

Referenced by roms_import(), and roms_rotate().

◆ geo2grid_rho

integer, parameter esmf_roms_mod::geo2grid_rho = 0
private

Definition at line 161 of file esmf_roms.h.

161 integer, parameter :: geo2grid_rho = 0 ! RHO-points

Referenced by roms_import(), and roms_rotate().

◆ grid2geo_rho

integer, parameter esmf_roms_mod::grid2geo_rho = 1
private

Definition at line 162 of file esmf_roms.h.

162 integer, parameter :: grid2geo_rho = 1 ! export vector

Referenced by roms_export(), roms_import(), and roms_rotate().