ROMS
Loading...
Searching...
No Matches
Data Types | Functions/Subroutines | Variables
cmeps_roms_mod Module Reference

Data Types

type  esm_clock
 
type  esm_cplset
 
type  esm_field
 
type  esm_mesh
 
type  esm_model
 

Functions/Subroutines

subroutine, public roms_setservices (model, rc)
 
subroutine, private roms_create (localpet, petcount, mycomm, 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)
 
integer function, private field_index (fnames, fvalue)
 
subroutine, private report_timestamp (field, currtime, localpet, string, rc)
 
subroutine, private createscalarfield (field, fname, fcount, rc)
 
subroutine, private setscalarfieldvalues (field, vals, idxs, rc)
 

Variables

type(esm_clock), dimension(:), allocatable, target clockinfo
 
type(esm_cplset), dimension(:), allocatable, target coupled
 
type(esm_model), dimension(:), allocatable, target models
 
logical esm_track = .TRUE.
 
integer, parameter nmodels = 1
 
integer, parameter idriver = 0
 
integer, parameter iroms = 1
 
integer, dimension(:), allocatable nexport
 
integer, dimension(:), allocatable nimport
 
integer couplingtype = 1
 
integer linked_grid
 
integer, dimension(:), allocatable esmcomm
 
integer petrank
 
character(len=10), dimension(:), allocatable petlayoutoption
 
integer debuglevel = 0
 
integer tracelevel = 0
 
integer cplout = 77
 
integer trac = 6
 
character(len=11), parameter couplerlog = 'log.coupler'
 
integer, parameter inan = 0
 
integer, parameter icenter = 1
 
integer, parameter icorner = 2
 
integer, parameter iupoint = 3
 
integer, parameter ivpoint = 4
 
character(len=6), dimension(0:4) gridtype = (/ 'N/A ', 'Center', 'Corner', 'U ', 'V ' /)
 
integer, parameter inone = 0
 
integer, parameter ibilin = 1
 
integer, parameter ipatch = 2
 
integer, parameter iconsvd = 3
 
integer, parameter iconsvf = 4
 
integer, parameter ifcopy = 5
 
integer, parameter instod = 6
 
integer, parameter instodd = 7
 
integer, parameter instodf = 8
 
character(len=256), dimension(:), allocatable inpname
 
character(len=:), allocatable cplname
 
character(len=44) todaydatestring
 
character(len=80) git_url
 
character(len=256) git_rev
 
character(len=:), allocatable coupledset
 
character(len=:), allocatable exportstatename
 
character(len=:), allocatable importstatename
 
integer(i4b), parameter mapped_mask = 99_i4b
 
integer(i4b), parameter unmapped_mask = 98_i4b
 
real(dp), parameter missing_dp = 1.0E20_dp
 
real(r4), parameter missing_r4 = 1.0E20_r4
 
real(r8), parameter missing_r8 = 1.0E20_r8
 
real(dp), parameter tol_dp = 0.001E20_dp
 
real(r4), parameter tol_r4 = 0.001E20_r4
 
real(r8), parameter tol_r8 = 0.001E20_r8
 
integer scalarfieldcount
 
integer scalarfieldidxgridnx
 
integer scalarfieldidxgridny
 
character(len=256) scalarfieldname
 
integer, parameter geo2grid = 0
 
integer, parameter geo2grid_rho = 0
 
integer, parameter grid2geo_rho = 1
 

Function/Subroutine Documentation

◆ createscalarfield()

subroutine, private cmeps_roms_mod::createscalarfield ( type (esmf_field), intent(inout) field,
character (len=*), intent(in) fname,
integer, intent(in) fcount,
integer, intent(out) rc )
private

Definition at line 6956 of file cmeps_roms.h.

6957!
6958!=======================================================================
6959! !
6960! Creeates ESMF field to store set scalars !
6961! !
6962!=======================================================================
6963!
6964! Imported variable declarations.
6965!
6966 integer, intent(in) :: Fcount
6967 integer, intent(out) :: rc
6968!
6969 character (len=*), intent(in) :: Fname
6970!
6971 TYPE (ESMF_Field) , intent(inout) :: Field
6972!
6973! Local variable declarations.
6974!
6975 TYPE (ESMF_Grid) :: grid
6976 TYPE (ESMF_DistGrid) :: distgrid
6977!
6978 character (len=*), parameter :: MyFile = &
6979 & __FILE__//", CreateScalarField"
6980!
6981!-----------------------------------------------------------------------
6982! Initialize return code flag to success state (no error).
6983!-----------------------------------------------------------------------
6984!
6985 rc=esmf_success
6986!
6987!-----------------------------------------------------------------------
6988! Create ESMF field
6989!-----------------------------------------------------------------------
6990!
6991 distgrid = esmf_distgridcreate(minindex=(/1/), &
6992 & maxindex=(/1/), &
6993 & rc=rc)
6994 IF (esmf_logfounderror(rctocheck=rc, &
6995 & msg=esmf_logerr_passthru, &
6996 & line=__line__, &
6997 & file=myfile)) THEN
6998 RETURN
6999 END IF
7000!
7001 grid = esmf_gridcreate(distgrid, rc=rc)
7002 IF (esmf_logfounderror(rctocheck=rc, &
7003 & msg=esmf_logerr_passthru, &
7004 & line=__line__, &
7005 & file=myfile)) THEN
7006 RETURN
7007 END IF
7008!
7009 field = esmf_fieldcreate(name=trim(fname), &
7010 & grid=grid, &
7011 & typekind=esmf_typekind_r8, &
7012 & gridtofieldmap=(/2/), &
7013 & ungriddedlbound=(/1/), &
7014 & ungriddedubound=(/fcount/), &
7015 & rc=rc)
7016 IF (esmf_logfounderror(rctocheck=rc, &
7017 & msg=esmf_logerr_passthru, &
7018 & line=__line__, &
7019 & file=myfile)) THEN
7020 RETURN
7021 END IF
7022!
7023 RETURN

References mod_grid::grid.

Referenced by roms_setstates().

Here is the caller graph for this function:

◆ field_index()

integer function, private cmeps_roms_mod::field_index ( type (esm_field), dimension(:), intent(in) fnames,
character (len=*), intent(in) fvalue )
private

Definition at line 6792 of file cmeps_roms.h.

6793!
6794!=======================================================================
6795! !
6796! This integer function scans an array structure of type ESM_Field !
6797! containing fields short_name list for specific field value and !
6798! returns its location index in the list. !
6799! !
6800!=======================================================================
6801!
6802! Imported variable declarations.
6803!
6804 character (len=*), intent(in) :: Fvalue
6805
6806 TYPE (ESM_Field), intent(in) :: Fnames(:)
6807!
6808! Local variable declarations.
6809!
6810 integer :: Mfields
6811 integer :: i
6812!
6813!-----------------------------------------------------------------------
6814! Find index of specified field from names list.
6815!-----------------------------------------------------------------------
6816!
6817 mfields=SIZE(fnames, dim=1)
6818 findex=-1
6819!
6820 DO i=1,mfields
6821 IF (trim(fnames(i)%short_name).eq.trim(fvalue)) THEN
6822 findex=i
6823 EXIT
6824 END IF
6825 END DO
6826!
6827 RETURN

Referenced by roms_import(), and roms_setstates().

Here is the caller graph for this function:

◆ report_timestamp()

subroutine, private cmeps_roms_mod::report_timestamp ( type (esmf_field), intent(in) field,
type (esmf_time), intent(in) currtime,
integer, intent(in) localpet,
character (len=*), intent(in) string,
integer, intent(out) rc )
private

Definition at line 6830 of file cmeps_roms.h.

6832!
6833!=======================================================================
6834! !
6835! Reports coupling time-stamp. !
6836! !
6837!=======================================================================
6838!
6839! Imported variable declarations.
6840!
6841 integer, intent(in) :: localPET
6842 integer, intent(out) :: rc
6843!
6844 character (len=*), intent(in) :: string
6845!
6846 TYPE (ESMF_Field), intent(in) :: field
6847 TYPE (ESMF_Time), intent(in) :: CurrTime
6848!
6849! Local variable declarations.
6850!
6851 logical :: IsValid
6852 integer :: vtime1(10), vtime2(10)
6853!
6854 TYPE (ESMF_Time) :: FieldTime
6855!
6856 character (len=*), parameter :: MyFile = &
6857 & __FILE__//", report_timestamp"
6858
6859 character (len=22) :: str1, str2
6860!
6861!-----------------------------------------------------------------------
6862! Initialize return code flag to success state (no error).
6863!-----------------------------------------------------------------------
6864!
6865 rc=esmf_success
6866!
6867!-----------------------------------------------------------------------
6868! Get driver current time.
6869!-----------------------------------------------------------------------
6870!
6871 CALL esmf_timeget (currtime, &
6872 & yy=vtime1(1), &
6873 & mm=vtime1(2), &
6874 & dd=vtime1(3), &
6875 & h =vtime1(4), &
6876 & m =vtime1(5), &
6877 & s =vtime1(6), &
6878 & rc=rc)
6879 IF (esmf_logfounderror(rctocheck=rc, &
6880 & msg=esmf_logerr_passthru, &
6881 & line=__line__, &
6882 & file=myfile)) THEN
6883 RETURN
6884 END IF
6885!
6886 WRITE (str1,10) vtime1(1), vtime1(2), vtime1(3), &
6887 & vtime1(4), vtime1(5), vtime1(6)
6888!
6889!-----------------------------------------------------------------------
6890! Get field TimeStamp.
6891!-----------------------------------------------------------------------
6892!
6893 CALL nuopc_gettimestamp (field, &
6894 & isvalid = isvalid, &
6895 & time = fieldtime, &
6896 & rc = rc)
6897 IF (esmf_logfounderror(rctocheck=rc, &
6898 & msg=esmf_logerr_passthru, &
6899 & line=__line__, &
6900 & file=myfile)) THEN
6901 RETURN
6902 END IF
6903!
6904 IF (isvalid) THEN
6905 CALL esmf_timeget (fieldtime, &
6906 & yy=vtime2(1), &
6907 & mm=vtime2(2), &
6908 & dd=vtime2(3), &
6909 & h =vtime2(4), &
6910 & m =vtime2(5), &
6911 & s =vtime2(6), &
6912 & rc=rc)
6913 IF (esmf_logfounderror(rctocheck=rc, &
6914 & msg=esmf_logerr_passthru, &
6915 & line=__line__, &
6916 & file=myfile)) THEN
6917 RETURN
6918 END IF
6919!
6920 WRITE (str2,10) vtime2(1), vtime2(2), vtime2(3), &
6921 & vtime2(4), vtime2(5), vtime2(6)
6922 END IF
6923!
6924!-----------------------------------------------------------------------
6925! Report TimeStamp.
6926!-----------------------------------------------------------------------
6927!
6928 IF (isvalid) THEN
6929 IF (trim(str1).ne.trim(str2)) THEN
6930 IF (localpet.eq.0) THEN
6931 WRITE (cplout,20) trim(string), ': TimeStamp = ', &
6932 & trim(str2), ' not equal ' , &
6933 & trim(str1)
6934 END IF
6935 rc=esmf_rc_val_wrong
6936 RETURN
6937 ELSE
6938 IF (localpet.eq.0) THEN
6939!! WRITE (cplout,30) TRIM(string), ': TimeStamp = ', TRIM(str2)
6940 END IF
6941 END IF
6942 ELSE
6943 IF (localpet.eq.0) THEN
6944 WRITE (cplout,30) trim(string), ': TimeStamp is not valid', &
6945 & ', DriverTime = '//trim(str1)
6946 END IF
6947 END IF
6948!
6949 10 FORMAT (i4.4,2('-',i2.2),1x,i2.2,':',i2.2,':',i2.2)
6950 20 FORMAT (/,1x,a,a,a,a,a)
6951 30 FORMAT (1x,a,a,a)
6952!
6953 RETURN

References cplout, mod_param::mm, and mod_scalars::time.

Referenced by roms_checkimport().

Here is the caller graph for this function:

◆ roms_checkimport()

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

Definition at line 2863 of file cmeps_roms.h.

2864!
2865!=======================================================================
2866! !
2867! Checks if ROMS component import field is at the correct time. !
2868! !
2869!=======================================================================
2870!
2871! Imported variable declarations.
2872!
2873 integer, intent(out) :: rc
2874!
2875 TYPE (ESMF_GridComp) :: model
2876!
2877! Local variable declarations.
2878!
2879 logical :: IsValid, atCorrectTime
2880!
2881 integer :: ImportCount, i, is, localPET, ng
2882!
2883 real (dp) :: TcurrentInSeconds
2884!
2885 character (len=22) :: DriverTimeString, FieldTimeString
2886
2887 character (len=*), parameter :: MyFile = &
2888 & __FILE__//", ROMS_CheckImport"
2889!
2890 character (ESMF_MAXSTR) :: string, FieldName
2891 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
2892!
2893 TYPE (ESMF_Clock) :: DriverClock
2894 TYPE (ESMF_Field) :: field
2895 TYPE (ESMF_Time) :: StartTime, CurrentTime
2896 TYPE (ESMF_Time) :: DriverTime, FieldTime
2897 TYPE (ESMF_TimeInterval) :: TimeStep
2898 TYPE (ESMF_VM) :: vm
2899!
2900!-----------------------------------------------------------------------
2901! Initialize return code flag to success state (no error).
2902!-----------------------------------------------------------------------
2903!
2904 IF (esm_track) THEN
2905 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_CheckImport', &
2906 & ', PET', petrank
2907 FLUSH (trac)
2908 END IF
2909 rc=esmf_success
2910!
2911!-----------------------------------------------------------------------
2912! Query component.
2913!-----------------------------------------------------------------------
2914!
2915 CALL nuopc_modelget (model, &
2916 & driverclock=driverclock, &
2917 & rc=rc)
2918 IF (esmf_logfounderror(rctocheck=rc, &
2919 & msg=esmf_logerr_passthru, &
2920 & line=__line__, &
2921 & file=myfile)) THEN
2922 RETURN
2923 END IF
2924!
2925 CALL esmf_gridcompget (model, &
2926 & localpet=localpet, &
2927 & vm=vm, &
2928 & rc=rc)
2929 IF (esmf_logfounderror(rctocheck=rc, &
2930 & msg=esmf_logerr_passthru, &
2931 & line=__line__, &
2932 & file=myfile)) THEN
2933 RETURN
2934 END IF
2935!
2936!-----------------------------------------------------------------------
2937! Get the start time and current time from driver clock.
2938!-----------------------------------------------------------------------
2939!
2940 CALL esmf_clockget (driverclock, &
2941 & timestep=timestep, &
2942 & starttime=starttime, &
2943 & currtime=drivertime, &
2944 & rc=rc)
2945 IF (esmf_logfounderror(rctocheck=rc, &
2946 & msg=esmf_logerr_passthru, &
2947 & line=__line__, &
2948 & file=myfile)) THEN
2949 RETURN
2950 END IF
2951!
2952! Adjust driver clock for semi-implicit coupling.
2953
2954 IF (couplingtype.eq.1) THEN
2955 currenttime=drivertime ! explicit coupling
2956 ELSE
2957 currenttime=drivertime+timestep ! semi-implicit coupling
2958 END IF
2959!
2960 CALL esmf_timeget (currenttime, &
2961 & s_r8=tcurrentinseconds, &
2962 & timestringisofrac=drivertimestring, &
2963 & rc=rc)
2964 IF (esmf_logfounderror(rctocheck=rc, &
2965 & msg=esmf_logerr_passthru, &
2966 & line=__line__, &
2967 & file=myfile)) THEN
2968 RETURN
2969 END IF
2970 is=index(drivertimestring, 'T') ! remove 'T' in
2971 IF (is.gt.0) drivertimestring(is:is)=' ' ! ISO 8601 format
2972!
2973!-----------------------------------------------------------------------
2974! Get list of import fields.
2975!-----------------------------------------------------------------------
2976!
2977 IF (nimport(iroms).gt.0) THEN
2978 nested_loop : DO ng=1,models(iroms)%Ngrids
2979 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2980 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2981 & itemcount=importcount, &
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 IF (.not.allocated(importnamelist)) THEN
2991 allocate ( importnamelist(importcount) )
2992 END IF
2993!
2994 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2995 & itemnamelist=importnamelist, &
2996 & rc=rc)
2997 IF (esmf_logfounderror(rctocheck=rc, &
2998 & msg=esmf_logerr_passthru, &
2999 & line=__line__, &
3000 & file=myfile)) THEN
3001 RETURN
3002 END IF
3003!
3004!-----------------------------------------------------------------------
3005! Only check fields in the ImportState object.
3006!-----------------------------------------------------------------------
3007!
3008 field_loop : DO i=1,importcount
3009 fieldname=trim(importnamelist(i))
3010 CALL esmf_stateget (models(iroms)%ImportState(ng), &
3011 & itemname=trim(fieldname), &
3012 & field=field, &
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! If debugging, report field timestamp.
3022!
3023 IF (debuglevel.gt.1) THEN
3024 CALL nuopc_gettimestamp (field, &
3025 & isvalid = isvalid, &
3026 & time = fieldtime, &
3027 & rc = rc)
3028 IF (esmf_logfounderror(rctocheck=rc, &
3029 & msg=esmf_logerr_passthru, &
3030 & line=__line__, &
3031 & file=myfile)) THEN
3032 RETURN
3033 END IF
3034!
3035 IF (isvalid) THEN
3036 CALL esmf_timeget (fieldtime, &
3037 & timestringisofrac = fieldtimestring, &
3038 & rc=rc)
3039 IF (esmf_logfounderror(rctocheck=rc, &
3040 & msg=esmf_logerr_passthru, &
3041 & line=__line__, &
3042 & file=myfile)) THEN
3043 RETURN
3044 END IF
3045 is=index(fieldtimestring, 'T') ! remove 'T'
3046 IF (is.gt.0) fieldtimestring(is:is)=' '
3047!
3048 IF (localpet.eq.0) THEN
3049 WRITE (cplout,10) trim(fieldname), &
3050 & trim(fieldtimestring), &
3051 & trim(drivertimestring)
3052 END IF
3053 END IF
3054 END IF
3055!
3056! Check if import field is at the correct time.
3057!
3058 string='ROMS_CheckImport - '//trim(fieldname)//' field'
3059!
3060 atcorrecttime=nuopc_isattime(field, &
3061 & currenttime, &
3062 & rc=rc)
3063 IF (esmf_logfounderror(rctocheck=rc, &
3064 & msg=esmf_logerr_passthru, &
3065 & line=__line__, &
3066 & file=myfile)) THEN
3067 RETURN
3068 END IF
3069!
3070 IF (.not.atcorrecttime) THEN
3071 CALL report_timestamp (field, currenttime, &
3072 & localpet, trim(string), rc)
3073!
3074 string='NUOPC INCOMPATIBILITY DETECTED: Import '// &
3075 & 'Fields not at correct time'
3076 CALL esmf_logseterror(esmf_rc_not_valid, &
3077 & msg=trim(string), &
3078 & line=__line__, &
3079 & file=myfile, &
3080 & rctoreturn=rc)
3081 RETURN
3082 END IF
3083 END DO field_loop
3084 IF (allocated(importnamelist)) deallocate (importnamelist)
3085 END IF
3086 END DO nested_loop
3087 END IF
3088!
3089 IF (esm_track) THEN
3090 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_CheckImport', &
3091 & ', PET', petrank
3092 FLUSH (trac)
3093 END IF
3094!
3095 10 FORMAT (1x,'ROMS_CheckImport - ',a,':',t32,'TimeStamp = ',a, &
3096 & ', DriverTime = ',a)
3097!
3098 RETURN

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

Referenced by roms_setservices().

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

◆ roms_create()

subroutine, private cmeps_roms_mod::roms_create ( integer, intent(in) localpet,
integer, intent(in) petcount,
integer, intent(in) mycomm,
integer, intent(out) rc )
private

Definition at line 674 of file cmeps_roms.h.

675!
676!=======================================================================
677! !
678! It allocates module structures and process configuration from input !
679! YAML file. !
680! !
681!=======================================================================
682!
683 USE mod_strings
684!
685! Imported variable declarations.
686!
687 integer, intent(in ) :: localPET, PETcount, MyComm
688 integer, intent(out) :: rc
689!
690! Local variable declarations.
691!
692# ifdef METADATA_REPORT
693 logical :: Lreport = .true. ! dumps YAML dictionary
694# else
695 logical :: Lreport = .false.
696# endif
697 logical :: Lexist, MasterPET
698!
699 integer :: Findex, i, layout, ng
700!
701 TYPE (CouplingField), allocatable :: Export(:), Import(:)
702 TYPE (yaml_Svec), allocatable :: Estring(:), Istring(:)
703 TYPE (yaml_tree) :: YML
704!
705 character (len=240) :: StandardName, ShortName
706 character (len=256) :: string
707
708 character (len=*), parameter :: MyFile = &
709 & __FILE__//", ROMS_Create"
710!
711!-----------------------------------------------------------------------
712! Initialize return code flag to success state (no error).
713!-----------------------------------------------------------------------
714!
715 IF (esm_track) THEN
716 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Create', &
717 & ', PET', petrank
718 FLUSH (trac)
719 END IF
720 rc=esmf_success
721!
722!-----------------------------------------------------------------------
723! Create YAML dictionary object (TYPE yaml_tree).
724!-----------------------------------------------------------------------
725!
726 IF (yaml_error(yaml_initialize(yml, trim(cplname), lreport), &
727 & noerror, __line__, myfile)) THEN
728 IF (localpet.eq.0) WRITE (cplout,10) trim(cplname)
729 rc=esmf_rc_file_read
730 RETURN
731 END IF
732!
733!-----------------------------------------------------------------------
734! Get ROMS standard input filename.
735!-----------------------------------------------------------------------
736!
737 IF (yml%has('standard_input.OCN_component')) THEN
738 IF (founderror(yaml_get(yml, 'standard_input.OCN_component', &
739 & string), &
740 & noerror, __line__, myfile)) THEN
741 rc=esmf_rc_copy_fail
742 RETURN
743 END IF
744 iname=trim(string)
745 ELSE
746 rc=esmf_rc_not_found
747 IF (localpet.eq.0) WRITE (cplout,20) &
748 & 'standard_input.OCN_component', &
749 & trim(cplname)
750 RETURN
751 END IF
752!
753! Get size of number of nested grids, 'Ngrids' parameter from ROMS
754! standard input file.
755!
756 masterpet=localpet.eq.0
757 CALL getpar_i (masterpet, ngrids, 'Ngrids', trim(iname))
758!
759!-----------------------------------------------------------------------
760! Get ROMS linked/coupled nested grid number for current application.
761!-----------------------------------------------------------------------
762!
763 IF (yml%has('linked_grid')) THEN
764 IF (founderror(yaml_get(yml, 'linked_grid', &
765 & linked_grid), &
766 & noerror, __line__, myfile)) THEN
767 rc=esmf_rc_copy_fail
768 RETURN
769 END IF
770 ELSE
771 linked_grid=1
772 END IF
773!
774!-----------------------------------------------------------------------
775! Allocate 'cap' module structure and variables.
776!-----------------------------------------------------------------------
777!
778! Coupled model(s) high-level objects.
779!
780 IF (.not.allocated(clockinfo)) THEN
781 allocate ( clockinfo(0:nmodels) ) ! TYPE ESM_Clock
782 END IF
783!
784 IF (.not.allocated(coupled)) THEN
785 allocate ( coupled(nmodels) ) ! TYPE ESM_CplSet
786 END IF
787!
788 IF (.not.allocated(models)) THEN
789 allocate ( models(nmodels) ) ! TYPE ESM_Model
790 END IF
791!
792! Number of export and import fields per component.
793!
794 IF (.not.allocated(nexport)) THEN
795 allocate ( nexport(nmodels) )
796 END IF
797!
798 IF (.not.allocated(nimport)) THEN
799 allocate ( nimport(nmodels) )
800 END IF
801!
802! Allocate and set several variables that depend on the number of ROMS
803! nested grids.
804!
805 IF (.not.allocated(esmcomm)) THEN
806 allocate ( esmcomm(nmodels) ) ! mpi-communicator
807 END IF
808 esmcomm(iroms)=mycomm
809!
810 IF (.not.allocated(petlayoutoption)) THEN
811 allocate ( petlayoutoption(nmodels) ) ! PET layout
812 END IF
813!
814 IF (.not.allocated(inpname)) THEN
815 allocate ( inpname(nmodels) ) ! standard input files
816 END IF
817 inpname(iroms)=trim(iname)
818!
819 IF (.not.allocated(models(iroms)%grid)) THEN
820 allocate ( models(iroms)%grid(ngrids) )
821 END IF
822!
823 IF (.not.allocated(coupled(iroms)%LinkedGrid)) THEN
824 allocate ( coupled(iroms)%LinkedGrid(ngrids,nmodels) )
825 coupled(iroms)%LinkedGrid=.false.
826 END IF
827 coupled(iroms)%LinkedGrid(linked_grid,:)=.true.
828!
829 IF (.not.allocated(coupled(iroms)%SetLabel)) THEN
830 allocate ( coupled(iroms)%SetLabel(ngrids) )
831 END IF
832!
833 IF (.not.allocated(coupled(iroms)%ExpLabel)) THEN
834 allocate ( coupled(iroms)%ExpLabel(ngrids) )
835 END IF
836!
837 IF (.not.allocated(coupled(iroms)%ImpLabel)) THEN
838 allocate ( coupled(iroms)%ImpLabel(ngrids) )
839 END IF
840!
841 IF (.not.allocated(models(iroms)%TimeFrac)) THEN
842 allocate ( models(iroms)%TimeFrac(ngrids,nmodels) )
843 models(iroms)%TimeFrac=0
844 END IF
845 models(iroms)%TimeFrac(linked_grid,:)=1
846!
847! Initialize module various variables.
848!
849 models(iroms)%Ngrids=ngrids
850 models(iroms)%IsActive=.true.
851 clockinfo(idriver)%Restarted=.false.
852 clockinfo(iroms )%Restarted=.false.
853!
854 IF (founderror(assign_string(models(iroms)%name, &
855 & 'ROMS'), &
856 & noerror, __line__, myfile)) THEN
857 rc=esmf_rc_copy_fail
858 RETURN
859 END IF
860!
861!-----------------------------------------------------------------------
862! Process export field(s) metadata from YAML object.
863!-----------------------------------------------------------------------
864!
865! Allocate ExportState structure. It is still needed if there are no
866! fields to export. It is needed for the 'scalar field' named
867! 'cpl_scalars' (see nems.configure) used by cmeps.
868!
869 IF (.not.allocated(models(iroms)%ExportState)) THEN
870 allocate ( models(iroms)%ExportState(ngrids) )
871 END IF
872!
873! Get export variables short name to process.
874!
875 IF (yml%has('export_variables')) THEN
876 IF (founderror(yaml_get(yml, 'export_variables', &
877 & estring), &
878 & noerror, __line__, myfile)) THEN
879 rc=esmf_rc_copy_fail
880 RETURN
881 END IF
882 nexport(iroms)=SIZE(estring)
883 ELSE
884 nexport(iroms)=0 ! no fields to export
885 END IF
886!
887! Extract export field metadata from dictionary.
888!
889 IF (nexport(iroms).gt.0) THEN
890 IF (yml%has('export')) THEN
891 CALL cmeps_metadata (yml, trim(cplname), 'export', &
892 & export)
893 IF (yaml_error(exit_flag, noerror, __line__, myfile)) THEN
894 rc=esmf_rc_val_wrong
895 RETURN
896 END IF
897 ELSE
898 rc=esmf_rc_not_found
899 IF (localpet.eq.0) WRITE (cplout,20) 'export', &
900 & trim(cplname)
901 RETURN
902 END IF
903!
904! Allocate export fields structure (TYPE ESM_Fields).
905!
906 IF (.not.allocated(models(iroms)%ExportField)) THEN
907 allocate ( models(iroms)%ExportField(nexport(iroms)) )
908 END IF
909!
910! Load export field(s) metadata.
911!
912 DO i=1,nexport(iroms)
913 shortname=estring(i)%value
914 findex=metadata_has(export, trim(shortname))
915 IF (findex.gt.0) THEN
916 models(iroms)%ExportField(i)%connected= &
917 & export(findex)%connected
918 models(iroms)%ExportField(i)%debug_write= &
919 & export(findex)%debug_write
920!
921 models(iroms)%ExportField(i)%add_offset= &
922 & export(findex)%add_offset
923 models(iroms)%ExportField(i)%scale_factor= &
924 & export(findex)%scale
925!
926! field short name
927 IF (founderror(assign_string( &
928 & models(iroms)%ExportField(i)%short_name, &
929 & export(findex)%short_name), &
930 & noerror, __line__, myfile)) THEN
931 rc=esmf_rc_copy_fail
932 RETURN
933 END IF
934! field standard name
935 IF (founderror(assign_string( &
936 & models(iroms)%ExportField(i)%standard_name, &
937 & export(findex)%standard_name), &
938 & noerror, __line__, myfile)) THEN
939 rc=esmf_rc_copy_fail
940 RETURN
941 END IF
942! field descriptive long name
943 IF (founderror(assign_string( &
944 & models(iroms)%ExportField(i)%long_name, &
945 & export(findex)%long_name), &
946 & noerror, __line__, myfile)) THEN
947 rc=esmf_rc_copy_fail
948 RETURN
949 END IF
950! field mapping normalization type
951 IF (founderror(assign_string( &
952 & models(iroms)%ExportField(i)%map_norm, &
953 & export(findex)%map_norm), &
954 & noerror, __line__, myfile)) THEN
955 rc=esmf_rc_copy_fail
956 RETURN
957 END IF
958! field reggriding method
959 IF (founderror(assign_string( &
960 & models(iroms)%ExportField(i)%map_type, &
961 & export(findex)%map_type), &
962 & noerror, __line__, myfile)) THEN
963 rc=esmf_rc_copy_fail
964 RETURN
965 END IF
966! destination field grid-cell type
967 IF (founderror(assign_string( &
968 & models(iroms)%ExportField(i)%dst_gtype, &
969 & export(findex)%destination_grid), &
970 & noerror, __line__, myfile)) THEN
971 rc=esmf_rc_copy_fail
972 RETURN
973 END IF
974! destination field units
975 IF (founderror(assign_string( &
976 & models(iroms)%ExportField(i)%dst_units, &
977 & export(findex)%destination_units), &
978 & noerror, __line__, myfile)) THEN
979 rc=esmf_rc_copy_fail
980 RETURN
981 END IF
982! source field grid-cell type
983 IF (founderror(assign_string( &
984 & models(iroms)%ExportField(i)%src_gtype, &
985 & export(findex)%source_grid), &
986 & noerror, __line__, myfile)) THEN
987 rc=esmf_rc_copy_fail
988 RETURN
989 END IF
990! source field units
991 IF (founderror(assign_string( &
992 & models(iroms)%ExportField(i)%src_units, &
993 & export(findex)%source_units), &
994 & noerror, __line__, myfile)) THEN
995 rc=esmf_rc_copy_fail
996 RETURN
997 END IF
998! DATA NetCDF variable name
999 IF (founderror(assign_string( &
1000 & models(iroms)%ExportField(i)%nc_vname, &
1001 & export(findex)%data_netcdf_vname), &
1002 & noerror, __line__, myfile)) THEN
1003 rc=esmf_rc_copy_fail
1004 RETURN
1005 END IF
1006! DATA NetCDF time variable name
1007 IF (founderror(assign_string( &
1008 & models(iroms)%ExportField(i)%nc_tname, &
1009 & export(findex)%data_netcdf_tname), &
1010 & noerror, __line__, myfile)) THEN
1011 rc=esmf_rc_copy_fail
1012 RETURN
1013 END IF
1014!
1015! Set grid type flag.
1016!
1017 SELECT CASE (lowercase(export(findex)%source_grid))
1018 CASE ('center_cell', 'cell_center', 'center')
1019 models(iroms)%ExportField(i)%gtype=icenter
1020 CASE ('corner_cell', 'cell_corner', 'corner')
1021 models(iroms)%ExportField(i)%gtype=icorner
1022 CASE ('left_right_edge', 'right_left_edge', 'edge1')
1023 models(iroms)%ExportField(i)%gtype=iupoint
1024 CASE ('lower_upper_edge', 'upper_lower_edge', 'edge2')
1025 models(iroms)%ExportField(i)%gtype=ivpoint
1026 CASE DEFAULT
1027 models(iroms)%ExportField(i)%gtype=icenter
1028 END SELECT
1029!
1030! Set map type flag.
1031!
1032 SELECT CASE (lowercase(export(findex)%map_type))
1033 CASE ('mapbilnr')
1034 models(iroms)%ExportField(i)%itype=ibilin
1035 CASE ('mappatch')
1036 models(iroms)%ExportField(i)%itype=ipatch
1037 CASE ('mapconsd')
1038 models(iroms)%ExportField(i)%itype=iconsvd
1039 CASE ('mapconsf')
1040 models(iroms)%ExportField(i)%itype=iconsvf
1041 CASE ('mapfcopy')
1042 models(iroms)%ExportField(i)%itype=ifcopy
1043 CASE ('mapnstod')
1044 models(iroms)%ExportField(i)%itype=instod
1045 CASE ('mapnstod_consd')
1046 models(iroms)%ExportField(i)%itype=instodd
1047 CASE ('mapnstod_consf')
1048 models(iroms)%ExportField(i)%itype=instodf
1049 CASE DEFAULT
1050 models(iroms)%ExportField(i)%itype=inone
1051 END SELECT
1052!
1053! Check if field exits in NUOPC dictionary.
1054!
1055 lexist=nuopc_fielddictionaryhasentry( &
1056 & models(iroms)%ExportField(i)%standard_name, &
1057 & rc=rc)
1058 IF (esmf_logfounderror(rctocheck=rc, &
1059 & msg=esmf_logerr_passthru, &
1060 & line=__line__, &
1061 & file=myfile)) THEN
1062 RETURN
1063 END IF
1064!
1065! If appropriate, add field to NUOPC dictionary.
1066!
1067 IF (.not.lexist) THEN
1068 CALL nuopc_fielddictionaryaddentry( &
1069 & models(iroms)%ExportField(i)%standard_name, &
1070 & canonicalunits = &
1071 & models(iroms)%ExportField(i)%src_units, &
1072 & rc=rc)
1073 IF (esmf_logfounderror(rctocheck=rc, &
1074 & msg=esmf_logerr_passthru, &
1075 & line=__line__, &
1076 & file=myfile)) THEN
1077 RETURN
1078 END IF
1079 END IF
1080 ELSE
1081 IF (localpet.eq.0) THEN
1082 WRITE (cplout,30) 'export field short_name: ', &
1083 & trim(shortname), trim(cplname)
1084 END IF
1085 rc=esmf_rc_not_found
1086 IF (esmf_logfounderror(rctocheck=rc, &
1087 & msg=esmf_logerr_passthru, &
1088 & line=__line__, &
1089 & file=myfile)) THEN
1090 RETURN
1091 END IF
1092 END IF
1093 END DO
1094 END IF
1095!
1096!-----------------------------------------------------------------------
1097! Process import field(s) metadata from YAML object.
1098!-----------------------------------------------------------------------
1099!
1100! Get import variables short name to process.
1101!
1102 IF (yml%has('import_variables')) THEN
1103 IF (founderror(yaml_get(yml, 'import_variables', &
1104 & istring), &
1105 & noerror, __line__, myfile)) THEN
1106 rc=esmf_rc_copy_fail
1107 RETURN
1108 END IF
1109 nimport(iroms)=SIZE(istring)
1110 ELSE
1111 nimport(iroms)=0 ! no fields to import
1112 END IF
1113
1114! Extract ROMS import field(s) metadata for YML dictionary.
1115!
1116 IF (nimport(iroms).gt.0) THEN
1117 IF (yml%has('import')) THEN
1118 CALL cmeps_metadata (yml, trim(cplname), 'import', &
1119 & import)
1120 IF (yaml_error(exit_flag, noerror, __line__, myfile)) THEN
1121 rc=esmf_rc_val_wrong
1122 RETURN
1123 END IF
1124 ELSE
1125 rc=esmf_rc_not_found
1126 IF (localpet.eq.0) WRITE (cplout,20) 'import', &
1127 & trim(cplname)
1128 RETURN
1129 END IF
1130!
1131! Allocate import fields structure (TYPE ESM_Fields).
1132!
1133 IF (.not.allocated(models(iroms)%ImportField)) THEN
1134 allocate ( models(iroms)%ImportField(nimport(iroms)) )
1135 END IF
1136!
1137 IF (.not.allocated(models(iroms)%ImportState)) THEN
1138 allocate ( models(iroms)%ImportState(ngrids) )
1139 END IF
1140!
1141! Load import field(s) metadata.
1142!
1143 DO i=1,nimport(iroms)
1144 shortname=istring(i)%value
1145 findex=metadata_has(import, trim(shortname))
1146 IF (findex.gt.0) THEN
1147 models(iroms)%ImportField(i)%connected= &
1148 & import(findex)%connected
1149 models(iroms)%ImportField(i)%debug_write= &
1150 & import(findex)%debug_write
1151!
1152 models(iroms)%ImportField(i)%add_offset= &
1153 & import(findex)%add_offset
1154 models(iroms)%ImportField(i)%scale_factor= &
1155 & import(findex)%scale
1156!
1157! field short name
1158 IF (founderror(assign_string( &
1159 & models(iroms)%ImportField(i)%short_name, &
1160 & import(findex)%short_name), &
1161 & noerror, __line__, myfile)) THEN
1162 rc=esmf_rc_copy_fail
1163 RETURN
1164 END IF
1165! field standard name
1166 IF (founderror(assign_string( &
1167 & models(iroms)%ImportField(i)%standard_name, &
1168 & import(findex)%standard_name), &
1169 & noerror, __line__, myfile)) THEN
1170 rc=esmf_rc_copy_fail
1171 RETURN
1172 END IF
1173! field descriptive long name
1174 IF (founderror(assign_string( &
1175 & models(iroms)%ImportField(i)%long_name, &
1176 & import(findex)%long_name), &
1177 & noerror, __line__, myfile)) THEN
1178 rc=esmf_rc_copy_fail
1179 RETURN
1180 END IF
1181! field mapping normalization type
1182 IF (founderror(assign_string( &
1183 & models(iroms)%ImportField(i)%map_norm, &
1184 & import(findex)%map_norm), &
1185 & noerror, __line__, myfile)) THEN
1186 rc=esmf_rc_copy_fail
1187 RETURN
1188 END IF
1189! field reggriding method
1190 IF (founderror(assign_string( &
1191 & models(iroms)%ImportField(i)%map_type, &
1192 & import(findex)%map_type), &
1193 & noerror, __line__, myfile)) THEN
1194 rc=esmf_rc_copy_fail
1195 RETURN
1196 END IF
1197! destination field grid-cell type
1198 IF (founderror(assign_string( &
1199 & models(iroms)%ImportField(i)%dst_gtype, &
1200 & import(findex)%destination_grid), &
1201 & noerror, __line__, myfile)) THEN
1202 rc=esmf_rc_copy_fail
1203 RETURN
1204 END IF
1205! destination field units
1206 IF (founderror(assign_string( &
1207 & models(iroms)%ImportField(i)%dst_units, &
1208 & import(findex)%destination_units), &
1209 & noerror, __line__, myfile)) THEN
1210 rc=esmf_rc_copy_fail
1211 RETURN
1212 END IF
1213! source field grid-cell type
1214 IF (founderror(assign_string( &
1215 & models(iroms)%ImportField(i)%src_gtype, &
1216 & import(findex)%source_grid), &
1217 & noerror, __line__, myfile)) THEN
1218 rc=esmf_rc_copy_fail
1219 RETURN
1220 END IF
1221! source field units
1222 IF (founderror(assign_string( &
1223 & models(iroms)%ImportField(i)%src_units, &
1224 & import(findex)%source_units), &
1225 & noerror, __line__, myfile)) THEN
1226 rc=esmf_rc_copy_fail
1227 RETURN
1228 END IF
1229! DATA NetCDF variable name
1230 IF (founderror(assign_string( &
1231 & models(iroms)%ImportField(i)%nc_vname, &
1232 & import(findex)%data_netcdf_vname), &
1233 & noerror, __line__, myfile)) THEN
1234 rc=esmf_rc_copy_fail
1235 RETURN
1236 END IF
1237! DATA NetCDF time variable name
1238 IF (founderror(assign_string( &
1239 & models(iroms)%ImportField(i)%nc_tname, &
1240 & import(findex)%data_netcdf_tname), &
1241 & noerror, __line__, myfile)) THEN
1242 rc=esmf_rc_copy_fail
1243 RETURN
1244 END IF
1245!
1246! Set grid type flag.
1247!
1248 SELECT CASE (lowercase(import(findex)%destination_grid))
1249 CASE ('center_cell', 'cell_center', 'center')
1250 models(iroms)%ImportField(i)%gtype=icenter
1251 CASE ('corner_cell', 'cell_corner', 'corner')
1252 models(iroms)%ImportField(i)%gtype=icorner
1253 CASE ('left_right_edge', 'right_left_edge', 'edge1')
1254 models(iroms)%ImportField(i)%gtype=iupoint
1255 CASE ('lower_upper_edge', 'upper_lower_edge', 'edge2')
1256 models(iroms)%ImportField(i)%gtype=ivpoint
1257 CASE DEFAULT
1258 models(iroms)%ImportField(i)%gtype=icenter
1259 END SELECT
1260!
1261! Set map type flag.
1262!
1263 SELECT CASE (lowercase(import(findex)%map_type))
1264 CASE ('mapbilnr')
1265 models(iroms)%ImportField(i)%itype=ibilin
1266 CASE ('mappatch')
1267 models(iroms)%ImportField(i)%itype=ipatch
1268 CASE ('mapconsd')
1269 models(iroms)%ImportField(i)%itype=iconsvd
1270 CASE ('mapconsf')
1271 models(iroms)%ImportField(i)%itype=iconsvf
1272 CASE ('mapfcopy')
1273 models(iroms)%ImportField(i)%itype=ifcopy
1274 CASE ('mapnstod')
1275 models(iroms)%ImportField(i)%itype=instod
1276 CASE ('mapnstod_consd')
1277 models(iroms)%ImportField(i)%itype=instodd
1278 CASE ('mapnstod_consf')
1279 models(iroms)%ImportField(i)%itype=instodf
1280 CASE DEFAULT
1281 models(iroms)%ImportField(i)%itype=inone
1282 END SELECT
1283!
1284! Check if field exits in NUOPC dictionary.
1285!
1286 lexist=nuopc_fielddictionaryhasentry( &
1287 & models(iroms)%ImportField(i)%standard_name, &
1288 & rc=rc)
1289 IF (esmf_logfounderror(rctocheck=rc, &
1290 & msg=esmf_logerr_passthru, &
1291 & line=__line__, &
1292 & file=myfile)) THEN
1293 RETURN
1294 END IF
1295!
1296! If appropriate, add field to NUOPC dictionary.
1297!
1298 IF (.not.lexist) THEN
1299 CALL nuopc_fielddictionaryaddentry( &
1300 & models(iroms)%ImportField(i)%standard_name, &
1301 & canonicalunits = &
1302 & models(iroms)%ImportField(i)%src_units, &
1303 & rc=rc)
1304 IF (esmf_logfounderror(rctocheck=rc, &
1305 & msg=esmf_logerr_passthru, &
1306 & line=__line__, &
1307 & file=myfile)) THEN
1308 RETURN
1309 END IF
1310 END IF
1311 ELSE
1312 IF (localpet.eq.0) THEN
1313 WRITE (cplout,30) 'import field short_name: ', &
1314 & trim(shortname), trim(cplname)
1315 END IF
1316 rc=esmf_rc_not_found
1317 IF (esmf_logfounderror(rctocheck=rc, &
1318 & msg=esmf_logerr_passthru, &
1319 & line=__line__, &
1320 & file=myfile)) THEN
1321 RETURN
1322 END IF
1323 END IF
1324 END DO
1325 END IF
1326!
1327!-----------------------------------------------------------------------
1328! Extract other configuration parameters from YAML object.
1329!-----------------------------------------------------------------------
1330!
1331! Coupling type: explicit or semi-implicit.
1332!
1333 IF (yml%has('CouplingType')) THEN
1334 IF (founderror(yaml_get(yml, 'CouplingType', &
1335 & couplingtype), &
1336 & noerror, __line__, myfile)) THEN
1337 rc=esmf_rc_copy_fail
1338 RETURN
1339 END IF
1340 ELSE
1341 rc=esmf_rc_not_found
1342 IF (localpet.eq.0) WRITE (cplout,20) 'CouplingType', &
1343 & trim(cplname)
1344 RETURN
1345 END IF
1346!
1347! PET layout: sequential or concurrent.
1348!
1349 IF (yml%has('PETlayoutOption')) THEN
1350 IF (founderror(yaml_get(yml, 'PETlayoutOption', &
1351 & layout), &
1352 & noerror, __line__, myfile)) THEN
1353 rc=esmf_rc_copy_fail
1354 RETURN
1355 END IF
1356 END IF
1357!
1358 SELECT CASE (layout)
1359 CASE (0)
1360 petlayoutoption(iroms)='SEQUENTIAL'
1361 CASE (1)
1362 petlayoutoption(iroms)='CONCURRENT'
1363 END SELECT
1364!
1365! Coupled state labels.
1366!
1367 IF (yml%has('CoupledSet')) THEN
1368 IF (founderror(yaml_get(yml, 'CoupledSet', &
1369 & string), &
1370 & noerror, __line__, myfile)) THEN
1371 rc=esmf_rc_copy_fail
1372 RETURN
1373 END IF
1374 coupled(iroms)%SetLabel(linked_grid)=trim(string)
1375 END IF
1376!
1377 IF (yml%has('ExportState')) THEN
1378 IF (founderror(yaml_get(yml, 'ExportState', &
1379 & string), &
1380 & noerror, __line__, myfile)) THEN
1381 rc=esmf_rc_copy_fail
1382 RETURN
1383 END IF
1384 coupled(iroms)%ExpLabel(linked_grid)=trim(string)
1385 END IF
1386!
1387 IF (yml%has('ImportState')) THEN
1388 IF (founderror(yaml_get(yml, 'ImportState', &
1389 & string), &
1390 & noerror, __line__, myfile)) THEN
1391 rc=esmf_rc_copy_fail
1392 RETURN
1393 END IF
1394 coupled(iroms)%ImpLabel(linked_grid)=trim(string)
1395 END IF
1396!
1397! Coupling debugging flag.
1398!
1399 IF (yml%has('DebugLevel')) THEN
1400 IF (founderror(yaml_get(yml, 'DebugLevel', &
1401 & debuglevel), &
1402 & noerror, __line__, myfile)) THEN
1403 rc=esmf_rc_copy_fail
1404 RETURN
1405 END IF
1406 END IF
1407!
1408! Execution tracing flag.
1409!
1410 IF (yml%has('TraceLevel')) THEN
1411 IF (founderror(yaml_get(yml, 'TraceLevel', &
1412 & tracelevel), &
1413 & noerror, __line__, myfile)) THEN
1414 rc=esmf_rc_copy_fail
1415 RETURN
1416 END IF
1417 END IF
1418!
1419! Destroy YAML obeject and deallocate local structures.
1420!
1421 CALL yml%destroy ()
1422 IF (allocated(export)) deallocate (export)
1423 IF (allocated(import)) deallocate (import)
1424 IF (allocated(estring)) deallocate (estring)
1425 IF (allocated(istring)) deallocate (istring)
1426!
1427!-----------------------------------------------------------------------
1428! Report specified import and export states.
1429!-----------------------------------------------------------------------
1430!
1431 git_url=git_url
1432 git_rev=git_rev
1433!
1434 IF (localpet.eq.0) THEN
1435 CALL get_date (todaydatestring)
1436 WRITE (cplout,40) trim(esmf_version_string), &
1437 & trim(todaydatestring), &
1438 & trim(git_url), &
1439 & trim(git_rev), &
1440 & trim(my_os), &
1441 & trim(my_cpu), &
1442 & trim(my_fort), &
1443 & trim(my_fc), &
1444 & trim(my_fflags), &
1445 & mycomm, petcount
1446 WRITE (cplout,50) 'Coupling Input Metadata Filename = ', &
1447 & trim(cplname)
1448 WRITE (cplout,50) ' ROMS Input Parameters Filename = ', &
1449 & trim(iname)
1450 WRITE (cplout,'(a)') char(32) ! blank space
1451 WRITE (cplout,60) ' Number of nested grids = ', &
1452 ngrids
1453 WRITE (cplout,60) ' Coupled nested grid = ', &
1454 & linked_grid
1455 IF (couplingtype.eq.1) THEN
1456 WRITE (cplout,70) ' Coupling flag = ', &
1457 & couplingtype, &
1458 & ', Explicit coupling method'
1459 ELSE IF (couplingtype.eq.2) THEN
1460 WRITE (cplout,70) ' Coupling flag = ', &
1461 & couplingtype, &
1462 & ', Semi-Implicit coupling method'
1463 END IF
1464 IF (layout.eq.0) THEN
1465 WRITE (cplout,70) ' PETs layout option = ', &
1466 & layout, &
1467 & ', Sequential'
1468 ELSE IF (layout.eq.1) THEN
1469 WRITE (cplout,70) ' PETs layout option = ', &
1470 & layout, &
1471 & ', Concurrent'
1472 END IF
1473 WRITE (cplout,'(a)') char(32)
1474 WRITE (cplout,60) ' Coupling debugging level flag = ', &
1475 & debuglevel
1476 WRITE (cplout,60) ' Execution tracing level flag = ', &
1477 & tracelevel
1478!
1479 IF (nimport(iroms).gt.0) THEN
1480 WRITE (cplout,80) 'ROMS IMPORT Fields Metadata:'
1481 DO i=1,nimport(iroms)
1482 WRITE (cplout,90) &
1483 & trim(models(iroms)%ImportField(i)%short_name), &
1484 & trim(models(iroms)%ImportField(i)%standard_name), &
1485 & models(iroms)%ImportField(i)%gtype, &
1486 & models(iroms)%ImportField(i)%itype, &
1487 & models(iroms)%ImportField(i)%connected, &
1488 & models(iroms)%ImportField(i)%debug_write, &
1489 & models(iroms)%ImportField(i)%add_offset, &
1490 & models(iroms)%ImportField(i)%scale_factor
1491 END DO
1492 END IF
1493!
1494 IF (nexport(iroms).gt.0) THEN
1495 WRITE (cplout,80) 'ROMS EXPORT Fields Metadata:'
1496 DO i=1,nexport(iroms)
1497 WRITE (cplout,90) &
1498 & trim(models(iroms)%ExportField(i)%short_name), &
1499 & trim(models(iroms)%ExportField(i)%standard_name), &
1500 & models(iroms)%ExportField(i)%gtype, &
1501 & models(iroms)%ExportField(i)%itype, &
1502 & models(iroms)%ExportField(i)%connected, &
1503 & models(iroms)%ExportField(i)%debug_write, &
1504 & models(iroms)%ExportField(i)%add_offset, &
1505 & models(iroms)%ExportField(i)%scale_factor
1506 END DO
1507 END IF
1508 WRITE (cplout,100)
1509 END IF
1510!
1511 IF (esm_track) THEN
1512 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Create', &
1513 & ', PET', petrank
1514 FLUSH (trac)
1515 END IF
1516!
1517 10 FORMAT (/,' ROMS_CREATE - Unable to create YAML object for', &
1518 & ' ROMS/CMEPS configuration metadata file: ',/,15x,a,/, &
1519 & 15x,'Default file is located in source directory.')
1520 20 FORMAT (/," ROMS_CREATE - Unable to find key: '",a,"'", &
1521 & ' ROMS/CMEPS configuration metadata file: ',/,15x,a,/, &
1522 & /,15x,'YAML file: ',a)
1523 30 FORMAT (/,' ROMS_CREATE - cannot find metadata for', &
1524 & 1x,a,'''',a,'''.',/,15x, &
1525 & 'Add entry to metadata file: ',a)
1526 40 FORMAT (80('-'),/, &
1527 & ' Earth System Models Coupling: ESMF/NUOPC Library,', &
1528 & ' Version ',a,/,31x,a,/, &
1529 & 80('-'), &
1530 & /,1x,'GIT Root URL : ',a, &
1531 & /,1x,'GIT Revision : ',a, &
1532 & /,1x,'Operating System : ',a, &
1533 & /,1x,'CPU Hardware : ',a, &
1534 & /,1x,'Compiler System : ',a, &
1535 & /,1x,'Compiler Command : ',a, &
1536 & /,1x,'Compiler Flags : ',a, &
1537 & /,1x,'MPI Communicator : ',i0,2x,'PET size = ',i0, &
1538 & /,80('-'),/)
1539 50 FORMAT (1x,a,a)
1540 60 FORMAT (1x,a,i0)
1541 70 FORMAT (1x,a,i0,a)
1542 80 FORMAT (/,a,/, 27('='),/,/, 'Short Name', &
1543 & t15,'Standard Name', t74,'G', t77,'R', t80,'C', t83,'W', &
1544 & t87,'add_offset', t99,'scale_factor',/, 111('-'))
1545 90 FORMAT (a, t15,a, t74,i1, t77,i1, t80,l1, t83,l1, &
1546 & t86,1p,e12.5, t100,1p,e12.5)
1547 100 FORMAT (/,' G: Grid cell location, 1=Center,', &
1548 & ' 2=Corner,', &
1549 & ' 3=U-point,', &
1550 & ' 4=V-point', &
1551 & /,' R: Regridding method, 1=bilin,', &
1552 & ' 2=patch,', &
1553 & ' 3=consD,', &
1554 & ' 4=consF,', &
1555 & ' 5=redist,', &
1556 & ' 6=nStoD,', &
1557 & ' 7=nStoD-consD,', &
1558 & ' 8=nStoD-consF', &
1559 & /,' C: Connected to coupler, F=derived from other,', &
1560 & ' T=exchanged/regridded', &
1561 & /,' W: Field write to NetCDF, F=false, T=true', &
1562 & ' (used if DebugLevel > 2)'/)
1563!
1564 RETURN
mod_strings
Definition mod_strings.F:2
mod_strings::my_cpu
character(len=80) my_cpu
Definition mod_strings.F:258
mod_strings::my_os
character(len=80) my_os
Definition mod_strings.F:257
mod_strings::my_fort
character(len=80) my_fort
Definition mod_strings.F:259
mod_strings::my_fflags
character(len=512) my_fflags
Definition mod_strings.F:261
mod_strings::my_fc
character(len=80) my_fc
Definition mod_strings.F:260

References strings_mod::assign_string(), clockinfo, get_metadata_mod::cmeps_metadata(), coupled, couplingtype, cplname, cplout, debuglevel, esm_track, esmcomm, mod_scalars::exit_flag, strings_mod::founderror(), dateclock_mod::get_date(), mod_ncparam::git_rev, mod_ncparam::git_url, ibilin, icenter, iconsvd, iconsvf, icorner, idriver, ifcopy, mod_iounits::iname, inone, inpname, instod, instodd, instodf, ipatch, iroms, iupoint, ivpoint, linked_grid, strings_mod::lowercase(), get_metadata_mod::metadata_has(), models, mod_strings::my_cpu, mod_strings::my_fc, mod_strings::my_fflags, mod_strings::my_fort, mod_strings::my_os, nexport, mod_param::ngrids, nimport, nmodels, mod_scalars::noerror, petlayoutoption, petrank, todaydatestring, trac, tracelevel, yaml_parser_mod::yaml_error(), yaml_parser_mod::yaml_initialize(), and get_metadata_mod::yml.

Referenced by roms_setinitializep1().

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

◆ roms_datainit()

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

Definition at line 2330 of file cmeps_roms.h.

2331!
2332!=======================================================================
2333! !
2334! Exports ROMS component fields during initialization or restart. !
2335! !
2336!=======================================================================
2337!
2338! Imported variable declarations.
2339!
2340 integer, intent(out) :: rc
2341!
2342 TYPE (ESMF_GridComp) :: model
2343!
2344! Local variable declarations.
2345!
2346 integer :: ng
2347!
2348 character (len=*), parameter :: MyFile = &
2349 & __FILE__//", ROMS_DataInit"
2350!
2351 TYPE (ESMF_Time) :: CurrentTime
2352!
2353!-----------------------------------------------------------------------
2354! Initialize return code flag to success state (no error).
2355!-----------------------------------------------------------------------
2356!
2357 IF (esm_track) THEN
2358 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_DataInit', &
2359 & ', PET', petrank
2360 FLUSH (trac)
2361 END IF
2362 rc=esmf_success
2363!
2364!-----------------------------------------------------------------------
2365! Get gridded component clock current time.
2366!-----------------------------------------------------------------------
2367!
2368 CALL esmf_clockget (clockinfo(iroms)%Clock, &
2369 & currtime=currenttime, &
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!-----------------------------------------------------------------------
2379! Export initialization or restart fields.
2380!-----------------------------------------------------------------------
2381!
2382 IF (nexport(iroms).gt.0) THEN
2383 DO ng=1,models(iroms)%Ngrids
2384 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2385 CALL roms_export (ng, model, rc)
2386 IF (esmf_logfounderror(rctocheck=rc, &
2387 & msg=esmf_logerr_passthru, &
2388 & line=__line__, &
2389 & file=myfile)) THEN
2390 RETURN
2391 END IF
2392 END IF
2393 END DO
2394 END IF
2395!
2396 IF (esm_track) THEN
2397 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_DataInit', &
2398 & ', PET', petrank
2399 FLUSH (trac)
2400 END IF
2401!
2402 RETURN

References clockinfo, coupled, esm_track, iroms, models, nexport, petrank, roms_export(), and 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 cmeps_roms_mod::roms_export ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 6001 of file cmeps_roms.h.

6002!
6003!=======================================================================
6004! !
6005! Exports ROMS fields to other coupled gridded components. !
6006! !
6007!=======================================================================
6008!
6009! Imported variable declarations.
6010!
6011 integer, intent(in) :: ng
6012 integer, intent(out) :: rc
6013!
6014 TYPE (ESMF_GridComp) :: model
6015!
6016! Local variable declarations.
6017!
6018 logical :: get_barotropic
6019 logical :: get_SurfaceCurrent
6020!
6021 integer :: Istr, Iend, Jstr, Jend
6022 integer :: IstrR, IendR, JstrR, JendR
6023 integer :: LBi, UBi, LBj, UBj
6024 integer :: ExportCount
6025 integer :: localDE, localDEcount, localPET, tile
6026 integer :: year, month, day, hour, minutes, seconds, sN, SD
6027 integer :: ifld, i, is, j
6028!
6029 real (dp) :: Fmin(1), Fmax(1), Fval, MyFmin(1), MyFmax(1)
6030!
6031 real (dp), pointer :: ptr2d(:,:) => null()
6032!
6033 real (dp), allocatable :: Ubar(:,:), Vbar(:,:)
6034 real (dp), allocatable :: Usur(:,:), Vsur(:,:)
6035!
6036 character (len=22) :: Time_CurrentString
6037
6038 character (len=:), allocatable :: fldname
6039
6040 character (len=*), parameter :: MyFile = &
6041 & __FILE__//", ROMS_Export"
6042
6043 character (ESMF_MAXSTR) :: cname, ofile
6044 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
6045!
6046 TYPE (ESMF_Field) :: field
6047 TYPE (ESMF_Time) :: CurrentTime
6048 TYPE (ESMF_VM) :: vm
6049!
6050!-----------------------------------------------------------------------
6051! Initialize return code flag to success state (no error).
6052!-----------------------------------------------------------------------
6053!
6054 IF (esm_track) THEN
6055 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Export', &
6056 & ', PET', petrank
6057 FLUSH (trac)
6058 END IF
6059 rc=esmf_success
6060!
6061!-----------------------------------------------------------------------
6062! Get information about the gridded component.
6063!-----------------------------------------------------------------------
6064!
6065 CALL esmf_gridcompget (model, &
6066 & localpet=localpet, &
6067 & vm=vm, &
6068 & name=cname, &
6069 & rc=rc)
6070 IF (esmf_logfounderror(rctocheck=rc, &
6071 & msg=esmf_logerr_passthru, &
6072 & line=__line__, &
6073 & file=myfile)) THEN
6074 RETURN
6075 END IF
6076!
6077! Get number of local decomposition elements (DEs). Usually, a single
6078! DE is associated with each Persistent Execution Thread (PETs). Thus,
6079! localDEcount=1.
6080!
6081 CALL esmf_gridget (models(iroms)%grid(ng), &
6082 & localdecount=localdecount, &
6083 & rc=rc)
6084 IF (esmf_logfounderror(rctocheck=rc, &
6085 & msg=esmf_logerr_passthru, &
6086 & line=__line__, &
6087 & file=myfile)) THEN
6088 RETURN
6089 END IF
6090!
6091! Set horizontal tile bounds.
6092!
6093 tile=localpet
6094!
6095 lbi=bounds(ng)%LBi(tile) ! lower bound I-direction
6096 ubi=bounds(ng)%UBi(tile) ! upper bound I-direction
6097 lbj=bounds(ng)%LBj(tile) ! lower bound J-direction
6098 ubj=bounds(ng)%UBj(tile) ! upper bound J-direction
6099!
6100 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
6101 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
6102 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
6103 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
6104!
6105 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
6106 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
6107 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
6108 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
6109!
6110!-----------------------------------------------------------------------
6111! Get current time.
6112!-----------------------------------------------------------------------
6113!
6114 CALL esmf_clockget (clockinfo(iroms)%Clock, &
6115 & currtime=currenttime, &
6116 & rc=rc)
6117 IF (esmf_logfounderror(rctocheck=rc, &
6118 & msg=esmf_logerr_passthru, &
6119 & line=__line__, &
6120 & file=myfile)) THEN
6121 RETURN
6122 END IF
6123!
6124 CALL esmf_timeget (currenttime, &
6125 & yy=year, &
6126 & mm=month, &
6127 & dd=day, &
6128 & h =hour, &
6129 & m =minutes, &
6130 & s =seconds, &
6131 & sn=sn, &
6132 & sd=sd, &
6133 & timestring=time_currentstring, &
6134 & rc=rc)
6135 IF (esmf_logfounderror(rctocheck=rc, &
6136 & msg=esmf_logerr_passthru, &
6137 & line=__line__, &
6138 & file=myfile)) THEN
6139 RETURN
6140 END IF
6141 is=index(time_currentstring, 'T') ! remove 'T' in
6142 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
6143!
6144!-----------------------------------------------------------------------
6145! Get list of export fields.
6146!-----------------------------------------------------------------------
6147!
6148 CALL esmf_stateget (models(iroms)%ExportState(ng), &
6149 & itemcount=exportcount, &
6150 & rc=rc)
6151 IF (esmf_logfounderror(rctocheck=rc, &
6152 & msg=esmf_logerr_passthru, &
6153 & line=__line__, &
6154 & file=myfile)) THEN
6155 RETURN
6156 END IF
6157!
6158 IF (.not. allocated(exportnamelist)) THEN
6159 allocate ( exportnamelist(exportcount) )
6160 END IF
6161!
6162 CALL esmf_stateget (models(iroms)%ExportState(ng), &
6163 & itemnamelist=exportnamelist, &
6164 & rc=rc)
6165 IF (esmf_logfounderror(rctocheck=rc, &
6166 & msg=esmf_logerr_passthru, &
6167 & line=__line__, &
6168 & file=myfile)) THEN
6169 RETURN
6170 END IF
6171!
6172!-----------------------------------------------------------------------
6173! Load export fields.
6174!-----------------------------------------------------------------------
6175!
6176 get_barotropic=.true.
6177 get_surfacecurrent=.true.
6178!
6179 fld_loop : DO ifld=1,exportcount
6180!
6181! Get field from export state.
6182!
6183 CALL esmf_stateget (models(iroms)%ExportState(ng), &
6184 & trim(exportnamelist(ifld)), &
6185 & field, &
6186 & rc=rc)
6187 IF (esmf_logfounderror(rctocheck=rc, &
6188 & msg=esmf_logerr_passthru, &
6189 & line=__line__, &
6190 & file=myfile)) THEN
6191 RETURN
6192 END IF
6193!
6194! Skip if it is scalar field.
6195!
6196 IF (trim(exportnamelist(ifld)) == trim(scalarfieldname)) THEN
6197 cycle
6198 END IF
6199!
6200! Get field pointer. Usually, the DO-loop is executed once since
6201! localDEcount=1.
6202!
6203 de_loop : DO localde=0,localdecount-1
6204 CALL esmf_fieldget (field, &
6205 & localde=localde, &
6206 & farrayptr=ptr2d, &
6207 & rc=rc)
6208 IF (esmf_logfounderror(rctocheck=rc, &
6209 & msg=esmf_logerr_passthru, &
6210 & line=__line__, &
6211 & file=myfile)) THEN
6212 RETURN
6213 END IF
6214!
6215! Initialize pointer to missing value.
6216!
6217 ptr2d=missing_dp
6218!
6219! Load field data into export state. Notice that all export fields
6220! are kept as computed by ROMS. The imported component does the
6221! proper scaling, physical units conversion, and other manipulations.
6222! It is done to avoid applying such transformations twice.
6223!
6224 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
6225!
6226! Sea surface temperature (C).
6227# if defined EXCLUDE_SPONGE && \
6228 (defined data_coupling && !defined ANA_SPONGE)
6229! If using a diffusion sponge, remove the SST points in the sponge area
6230! to supress the spurious influence of open boundary conditions in the
6231! computation of the net heat flux. The SST values in the sponge are
6232! from the large scale DATA component in the merged ocean/data field
6233! imported by the atmosphere model.
6234# endif
6235!
6236 CASE ('sst', 'SST')
6237 myfmin(1)= missing_dp
6238 myfmax(1)=-missing_dp
6239 DO j=jstrr,jendr
6240 DO i=istrr,iendr
6241# if defined EXCLUDE_SPONGE && \
6242 (defined data_coupling && !defined ANA_SPONGE)
6243 IF (ltracersponge(itemp,ng).and. &
6244 & mixing(ng)%diff_factor(i,j).gt.1.0_dp) THEN
6245 fval=missing_dp
6246 ELSE
6247 fval=ocean(ng)%t(i,j,n(ng),nstp(ng),itemp)
6248# ifdef MASKING
6249 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
6250 myfmin(1)=min(myfmin(1),fval)
6251 myfmax(1)=max(myfmax(1),fval)
6252 END IF
6253# else
6254 myfmin(1)=min(myfmin(1),fval)
6255 myfmax(1)=max(myfmax(1),fval)
6256# endif
6257 END IF
6258# else
6259 fval=ocean(ng)%t(i,j,n(ng),nstp(ng),itemp)
6260# ifdef MASKING
6261 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
6262 myfmin(1)=min(myfmin(1),fval)
6263 myfmax(1)=max(myfmax(1),fval)
6264 END IF
6265# else
6266 myfmin(1)=min(myfmin(1),fval)
6267 myfmax(1)=max(myfmax(1),fval)
6268# endif
6269# endif
6270 ptr2d(i,j)=fval
6271 END DO
6272 END DO
6273!
6274! Sea surface height (m).
6275!
6276 CASE ('ssh', 'SSH')
6277 myfmin(1)=1.0_dp
6278 myfmax(1)=0.0_dp
6279 DO j=jstrr,jendr
6280 DO i=istrr,iendr
6281 fval=ocean(ng)%zeta(i,j,knew(ng))
6282# ifdef MASKING
6283 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
6284 myfmin(1)=min(myfmin(1),fval)
6285 myfmax(1)=max(myfmax(1),fval)
6286 END IF
6287# else
6288 myfmin(1)=min(myfmin(1),fval)
6289 myfmax(1)=max(myfmax(1),fval)
6290# endif
6291 ptr2d(i,j)=fval
6292 END DO
6293 END DO
6294!
6295! Depth-integrated (barotropic) currents (m/s) at interior RHO-points
6296! (East/North direction).
6297!
6298 CASE ('Ubar', 'Vbar')
6299 IF (founderror(assign_string(fldname, &
6300 & exportnamelist(ifld)), &
6301 & noerror, __line__, myfile)) THEN
6302 rc=esmf_rc_not_found
6303 RETURN
6304 END IF
6305!
6306 IF (get_barotropic) THEN
6307 get_barotropic=.false.
6308 IF (.not.allocated(ubar)) THEN
6309 allocate ( ubar(lbi:ubi,lbj:ubj) )
6310 ubar=missing_dp
6311 END IF
6312 IF (.not.allocated(vbar)) THEN
6313 allocate ( vbar(lbi:ubi,lbj:ubj) )
6314 vbar=missing_dp
6315 END IF
6316 CALL roms_rotate (ng, tile, grid2geo_rho, &
6317 & lbi, ubi, lbj, ubj, &
6318 & ocean(ng)%ubar(:,:,knew(ng)), &
6319 & ocean(ng)%vbar(:,:,knew(ng)), &
6320 & ubar, vbar)
6321 END IF
6322!
6323 IF (fldname.eq.'Ubar') THEN
6324 DO j=jstr,jend
6325 DO i=istr,iend
6326 fval=ubar(i,j)
6327 myfmin(1)=min(myfmin(1),fval)
6328 myfmax(1)=max(myfmax(1),fval)
6329 ptr2d(i,j)=fval
6330 END DO
6331 END DO
6332 deallocate (ubar)
6333 ELSE
6334 DO j=jstr,jend
6335 DO i=istr,iend
6336 fval=vbar(i,j)
6337 myfmin(1)=min(myfmin(1),fval)
6338 myfmax(1)=max(myfmax(1),fval)
6339 ptr2d(i,j)=fval
6340 END DO
6341 END DO
6342 deallocate (vbar)
6343 END IF
6344!
6345! Surface currents (m/s) at interior RHO-points (East/North direction).
6346!
6347 CASE ('Usur', 'Vsur')
6348 IF (founderror(assign_string(fldname, &
6349 & exportnamelist(ifld)), &
6350 & noerror, __line__, myfile)) THEN
6351 rc=esmf_rc_not_found
6352 RETURN
6353 END IF
6354!
6355 IF (get_surfacecurrent) THEN
6356 get_surfacecurrent=.false.
6357 IF (.not.allocated(ubar)) THEN
6358 allocate ( usur(lbi:ubi,lbj:ubj) )
6359 usur=missing_dp
6360 END IF
6361 IF (.not.allocated(vbar)) THEN
6362 allocate ( vsur(lbi:ubi,lbj:ubj) )
6363 vsur=missing_dp
6364 END IF
6365 CALL roms_rotate (ng, tile, grid2geo_rho, &
6366 & lbi, ubi, lbj, ubj, &
6367 & ocean(ng)%u(:,:,n(ng),nstp(ng)), &
6368 & ocean(ng)%v(:,:,n(ng),nstp(ng)), &
6369 & usur, vsur)
6370 END IF
6371!
6372 IF (fldname.eq.'Usur') THEN
6373 DO j=jstr,jend
6374 DO i=istr,iend
6375 fval=usur(i,j)
6376 myfmin(1)=min(myfmin(1),fval)
6377 myfmax(1)=max(myfmax(1),fval)
6378 ptr2d(i,j)=fval
6379 END DO
6380 END DO
6381 deallocate (usur)
6382 ELSE
6383 DO j=jstr,jend
6384 DO i=istr,iend
6385 fval=vsur(i,j)
6386 myfmin(1)=min(myfmin(1),fval)
6387 myfmax(1)=max(myfmax(1),fval)
6388 ptr2d(i,j)=fval
6389 END DO
6390 END DO
6391 deallocate (vsur)
6392 END IF
6393!
6394! Bathymetry (m). It can be time dependent due sediment morphology.
6395!
6396 CASE ('bath')
6397 myfmin(1)=1.0_dp
6398 myfmax(1)=0.0_dp
6399 DO j=jstrr,jendr
6400 DO i=istrr,iendr
6401 fval=grid(ng)%h(i,j)
6402 myfmin(1)=min(myfmin(1),fval)
6403 myfmax(1)=max(myfmax(1),fval)
6404 ptr2d(i,j)=fval
6405 END DO
6406 END DO
6407
6408# if defined MASKING
6409!
6410! Update wet point land/sea mask, if differs from static mask.
6411!
6412 CASE ('mask_rho', 'rmask', 'msk')
6413 myfmin(1)=1.0_dp
6414 myfmax(1)=0.0_dp
6415 DO j=jstrr,jendr
6416 DO i=istrr,iendr
6417 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
6418# ifdef WET_DRY
6419 IF (grid(ng)%rmask(i,j).ne. &
6420 & grid(ng)%rmask_wet(i,j)) THEN
6421 ptr2d(i,j)=grid(ng)%rmask_wet(i,j)
6422 ELSE
6423 ptr2d(i,j)=grid(ng)%rmask(i,j)
6424 END IF
6425# else
6426 ptr2d(i,j)=grid(ng)%rmask(i,j)
6427# endif
6428 myfmin(1)=min(myfmin(1),ptr2d(i,j))
6429 myfmax(1)=max(myfmax(1),ptr2d(i,j))
6430 END IF
6431 END DO
6432 END DO
6433# endif
6434!
6435! Export field not found.
6436!
6437 CASE DEFAULT
6438 IF (localpet.eq.0) THEN
6439 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
6440 & trim(cplname)
6441 END IF
6442 rc=esmf_rc_not_found
6443 IF (esmf_logfounderror(rctocheck=rc, &
6444 & msg=esmf_logerr_passthru, &
6445 & line=__line__, &
6446 & file=myfile)) THEN
6447 RETURN
6448 END IF
6449 END SELECT
6450!
6451! Nullify pointer to make sure that it does not point on a random
6452! part in the memory.
6453!
6454 IF (associated(ptr2d)) nullify (ptr2d)
6455 END DO de_loop
6456!
6457! Get export field minimun and maximum values.
6458!
6459 CALL esmf_vmallreduce (vm, &
6460 & senddata=myfmin, &
6461 & recvdata=fmin, &
6462 & count=1, &
6463 & reduceflag=esmf_reduce_min, &
6464 & rc=rc)
6465 IF (esmf_logfounderror(rctocheck=rc, &
6466 & msg=esmf_logerr_passthru, &
6467 & line=__line__, &
6468 & file=myfile)) THEN
6469 RETURN
6470 END IF
6471!
6472 CALL esmf_vmallreduce (vm, &
6473 & senddata=myfmax, &
6474 & recvdata=fmax, &
6475 & count=1, &
6476 & reduceflag=esmf_reduce_max, &
6477 & rc=rc)
6478 IF (esmf_logfounderror(rctocheck=rc, &
6479 & msg=esmf_logerr_passthru, &
6480 & line=__line__, &
6481 & file=myfile)) THEN
6482 RETURN
6483 END IF
6484!
6485 IF (localpet.eq.0) THEN
6486 WRITE (cplout,20) trim(exportnamelist(ifld)), &
6487 & trim(time_currentstring), ng, &
6488 & fmin(1), fmax(1)
6489 END IF
6490!
6491! Debugging: write out field into a NetCDF file.
6492!
6493 IF ((debuglevel.ge.3).and. &
6494 & models(iroms)%ExportField(ifld)%debug_write) THEN
6495 WRITE (ofile,30) ng, trim(exportnamelist(ifld)), &
6496 year, month, day, hour, minutes, seconds
6497 CALL esmf_fieldwrite (field, &
6498 & trim(ofile), &
6499 & overwrite=.true., &
6500 & rc=rc)
6501 IF (esmf_logfounderror(rctocheck=rc, &
6502 & msg=esmf_logerr_passthru, &
6503 & line=__line__, &
6504 & file=myfile)) THEN
6505 RETURN
6506 END IF
6507 END IF
6508 END DO fld_loop
6509!
6510! Deallocate local arrays.
6511!
6512 IF (allocated(exportnamelist)) deallocate (exportnamelist)
6513!
6514! Update ROMS export calls counter.
6515!
6516 IF (exportcount.gt.0) THEN
6517 models(iroms)%ExportCalls=models(iroms)%ExportCalls+1
6518 END IF
6519!
6520 IF (esm_track) THEN
6521 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Export', &
6522 & ', PET', petrank
6523 FLUSH (trac)
6524 END IF
6525 FLUSH (cplout)
6526!
6527 10 FORMAT (/,3x,' ROMS_Export - unable to find option to export: ', &
6528 & a,/,18x,'check ''Export(roms)'' in input YAML: ',a)
6529 20 FORMAT (3x,' ROMS_Export - ESMF: exporting field ''',a,'''', &
6530 & t72,a,2x,'Grid ',i2.2,/, &
6531 & 18x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
6532 & ')')
6533 30 FORMAT ('roms_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
6534 & i2.2,2('.',i2.2),'.nc')
6535
6536 RETURN

References strings_mod::assign_string(), mod_param::bounds, clockinfo, cplname, cplout, debuglevel, esm_track, strings_mod::founderror(), mod_grid::grid, grid2geo_rho, iroms, mod_scalars::itemp, mod_stepping::knew, mod_scalars::ltracersponge, missing_dp, mod_mixing::mixing, mod_param::mm, models, mod_param::n, mod_scalars::noerror, mod_stepping::nstp, mod_ocean::ocean, petrank, roms_rotate(), scalarfieldname, and 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 cmeps_roms_mod::roms_import ( integer, intent(in) ng,
type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 4347 of file cmeps_roms.h.

4348!
4349!=======================================================================
4350! !
4351! Imports fields into ROMS array structures. The fields aew loaded !
4352! into the snapshot storage arrays to allow time interpolation in !
4353! ROMS kernel. !
4354! !
4355!=======================================================================
4356!
4357! Imported variable declarations.
4358!
4359 integer, intent(in) :: ng
4360 integer, intent(out) :: rc
4361!
4362 TYPE (ESMF_GridComp) :: model
4363!
4364! Local variable declarations.
4365!
4366 logical :: LoadIt, isPresent
4367 logical :: got_stress(2), got_wind(2)
4368# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
4369 logical :: got_RhoAir, got_Wstar, got_wind_sbl(2)
4370# endif
4371!
4372 integer :: Istr, Iend, Jstr, Jend
4373 integer :: IstrR, IendR, JstrR, JendR
4374 integer :: LBi, UBi, LBj, UBj
4375 integer :: ImportCount, Tindex
4376 integer :: localDE, localDEcount, localPET, tile
4377 integer :: year, month, day, hour, minutes, seconds, sN, SD
4378 integer :: gtype, id, ifield, ifld, i, is, j
4379!
4380# ifdef TIME_INTERP
4381 integer, save :: record = 0
4382!
4383# endif
4384 real (dp), parameter :: eps = 1.0e-10_dp
4385!
4386 real (dp) :: TimeInDays, Time_Current, Tmin, Tmax, Tstr, Tend
4387# ifdef TIME_INTERP
4388 real (dp) :: MyTimeInDays
4389# endif
4390 real (dp) :: Fseconds, ROMSclockTime
4391 real (dp) :: MyTintrp(2), MyVtime(2)
4392
4393 real (dp) :: MyFmax(2), MyFmin(2), Fmin(2), Fmax(2), Fval
4394 real (dp) :: add_offset, romsScale, scale, cff1, cff2, cff3
4395 real (dp) :: FreshWaterScale, StressScale, TracerFluxScale
4396# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
4397 real (dp) :: Urel, Vrel, Wmag, Wrel
4398# endif
4399 real (dp) :: AttValues(14)
4400!
4401 real (dp), pointer :: ptr2d(:,:) => null()
4402!
4403# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
4404 real (dp), allocatable :: RhoAir(:,:), Wstar(:,:)
4405 real (dp), allocatable :: Uwrk(:,:), Vwrk(:,:)
4406 real (dp), allocatable :: Xwind(:,:), Ywind(:,:)
4407# endif
4408 real (dp), allocatable :: Ustress(:,:), Vstress(:,:)
4409 real (dp), allocatable :: Uwind(:,:), Vwind(:,:)
4410!
4411 character (len=22) :: MyDate(2)
4412# ifdef TIME_INTERP
4413 character (len=22) :: MyDateString(1,1,1)
4414# endif
4415 character (len=22) :: Time_CurrentString
4416 character (len=40) :: AttName
4417
4418 character (len=*), parameter :: MyFile = &
4419 & __FILE__//", ROMS_Import"
4420
4421 character (ESMF_MAXSTR) :: cname, ofile
4422 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
4423!
4424 TYPE (ESMF_AttPack) :: AttPack
4425 TYPE (ESMF_Clock) :: clock
4426 TYPE (ESMF_Field) :: field
4427 TYPE (ESMF_Time) :: CurrentTime
4428 TYPE (ESMF_VM) :: vm
4429
4430# ifdef TIME_INTERP
4431!
4432 sourcefile=myfile
4433# endif
4434!
4435!-----------------------------------------------------------------------
4436! Initialize return code flag to success state (no error).
4437!-----------------------------------------------------------------------
4438!
4439 IF (esm_track) THEN
4440 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Import', &
4441 & ', PET', petrank
4442 FLUSH (trac)
4443 END IF
4444 rc=esmf_success
4445!
4446!-----------------------------------------------------------------------
4447! Get information about the gridded component.
4448!-----------------------------------------------------------------------
4449!
4450 CALL esmf_gridcompget (model, &
4451 & clock=clock, &
4452 & localpet=localpet, &
4453 & vm=vm, &
4454 & name=cname, &
4455 & rc=rc)
4456 IF (esmf_logfounderror(rctocheck=rc, &
4457 & msg=esmf_logerr_passthru, &
4458 & line=__line__, &
4459 & file=myfile)) THEN
4460 RETURN
4461 END IF
4462!
4463! Get number of local decomposition elements (DEs). Usually, a single
4464! DE is associated with each Persistent Execution Thread (PETs). Thus,
4465! localDEcount=1.
4466!
4467 CALL esmf_gridget (models(iroms)%grid(ng), &
4468 & localdecount=localdecount, &
4469 & rc=rc)
4470 IF (esmf_logfounderror(rctocheck=rc, &
4471 & msg=esmf_logerr_passthru, &
4472 & line=__line__, &
4473 & file=myfile)) THEN
4474 RETURN
4475 END IF
4476!
4477! Set size of imported tiled-arrays.
4478!
4479 tile=localpet
4480!
4481 lbi=bounds(ng)%LBi(tile) ! lower bound I-direction
4482 ubi=bounds(ng)%UBi(tile) ! upper bound I-direction
4483 lbj=bounds(ng)%LBj(tile) ! lower bound J-direction
4484 ubj=bounds(ng)%UBj(tile) ! upper bound J-direction
4485!
4486 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
4487 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
4488 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
4489 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
4490!
4491 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
4492 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
4493 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
4494 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
4495!
4496!-----------------------------------------------------------------------
4497! Get current time.
4498!-----------------------------------------------------------------------
4499!
4500 CALL esmf_clockget (clock, &
4501 & currtime=currenttime, &
4502 & rc=rc)
4503 IF (esmf_logfounderror(rctocheck=rc, &
4504 & msg=esmf_logerr_passthru, &
4505 & line=__line__, &
4506 & file=myfile)) THEN
4507 RETURN
4508 END IF
4509!
4510 CALL esmf_timeget (currenttime, &
4511 & yy=year, &
4512 & mm=month, &
4513 & dd=day, &
4514 & h =hour, &
4515 & m =minutes, &
4516 & s =seconds, &
4517 & sn=sn, &
4518 & sd=sd, &
4519 & rc=rc)
4520 IF (esmf_logfounderror(rctocheck=rc, &
4521 & msg=esmf_logerr_passthru, &
4522 & line=__line__, &
4523 & file=myfile)) THEN
4524 RETURN
4525 END IF
4526!
4527 CALL esmf_timeget (currenttime, &
4528 & s_r8=time_current, &
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 timeindays=time_current/86400.0_dp
4538 is=index(time_currentstring, 'T') ! remove 'T' in
4539 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
4540!
4541!-----------------------------------------------------------------------
4542! Convert CurrentTime into ROMS clock ellapsed time since
4543! initialization in seconds from reference time.
4544! (The routine "ROMS_clock" is located in ROMS/Utility/dateclock.F)
4545!-----------------------------------------------------------------------
4546!
4547 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
4548 CALL roms_clock (year, month, day, hour, minutes, fseconds, &
4549 & romsclocktime)
4550!
4551!-----------------------------------------------------------------------
4552! Get list of import fields.
4553!-----------------------------------------------------------------------
4554!
4555 CALL esmf_stateget (models(iroms)%ImportState(ng), &
4556 & itemcount=importcount, &
4557 & rc=rc)
4558 IF (esmf_logfounderror(rctocheck=rc, &
4559 & msg=esmf_logerr_passthru, &
4560 & line=__line__, &
4561 & file=myfile)) THEN
4562 RETURN
4563 END IF
4564!
4565 IF (.not.allocated(importnamelist)) THEN
4566 allocate ( importnamelist(importcount) )
4567 END IF
4568 CALL esmf_stateget (models(iroms)%ImportState(ng), &
4569 & itemnamelist=importnamelist, &
4570 & rc=rc)
4571 IF (esmf_logfounderror(rctocheck=rc, &
4572 & msg=esmf_logerr_passthru, &
4573 & line=__line__, &
4574 & file=myfile)) THEN
4575 RETURN
4576 END IF
4577
4578# ifdef TIME_INTERP
4579!
4580!-----------------------------------------------------------------------
4581! Advance unlimited dimension counter.
4582!-----------------------------------------------------------------------
4583!
4584 IF (petlayoutoption.eq.'CONCURRENT') THEN
4585 record=record+1
4586 END IF
4587# endif
4588!
4589!-----------------------------------------------------------------------
4590! Get import fields.
4591!-----------------------------------------------------------------------
4592!
4593! Set switches to rotate wind stress and wind component for curvilinear
4594! ROMS grid applications.
4595!
4596 got_stress(1:2)=.false.
4597 got_wind(1:2)=.false.
4598# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
4599 got_rhoair=.false.
4600 got_wstar=.false.
4601 got_wind_sbl(1:2)=.false.
4602# endif
4603!
4604! Loop over all import fields to process.
4605!
4606 fld_loop : DO ifld=1,importcount
4607 id=field_index(models(iroms)%ImportField, importnamelist(ifld))
4608!
4609! Get field from import state.
4610!
4611 CALL esmf_stateget (models(iroms)%ImportState(ng), &
4612 & trim(importnamelist(ifld)), &
4613 & field, &
4614 & rc=rc)
4615 IF (esmf_logfounderror(rctocheck=rc, &
4616 & msg=esmf_logerr_passthru, &
4617 & line=__line__, &
4618 & file=myfile)) THEN
4619 RETURN
4620 END IF
4621
4622# ifdef TIME_INTERP
4623!
4624! If cuncurrent coupling and importing time snapshots, update values
4625! in the MODELS(Iroms)%ImportField structure by reading import field
4626! interpolation attributes from source NetCDF file. It is very tricky
4627! to perform inter VM communications. It is easier to read them from
4628! a NetCDF file. ROMS needs these attributes to perform the time
4629! interpolation between snapshots in its kernel.
4630! (HGA: need to figure out how to do inter VM communications)
4631!
4632 IF (petlayoutoption.eq.'CONCURRENT') THEN
4633 CALL netcdf_get_ivar (ng, inlm, attfilename, 'Tindex', &
4634 & models(iroms)%ImportField(id)%Tindex, &
4635 & start=(/iroms,id,record/), &
4636 & total=(/1,1,1/))
4637 IF (founderror(exit_flag, noerror, __line__, &
4638 & myfile)) THEN
4639 rc=esmf_rc_file_read
4640 RETURN
4641 END IF
4642!
4643 is=models(iroms)%ImportField(id)%Tindex
4644 CALL netcdf_get_svar (ng, inlm, attfilename, 'Date', &
4645 & mydatestring, &
4646 & start=(/1,iroms,id,record/), &
4647 & total=(/22,1,1,1/))
4648 IF (founderror(exit_flag, noerror, __line__, &
4649 & myfile)) THEN
4650 rc=esmf_rc_file_read
4651 RETURN
4652 END IF
4653 models(iroms)%ImportField(id)%DateString(is)= &
4654 & mydatestring(1,1,1)
4655!
4656 CALL netcdf_get_time (ng, inlm, attfilename, 'Tcurrent', &
4657 & rclock%DateNumber, mytimeindays, &
4658 & start=(/iroms,id,record/), &
4659 & total=(/1,1,1/))
4660 IF (founderror(exit_flag, noerror, __line__, &
4661 & myfile)) THEN
4662 rc=esmf_rc_file_read
4663 RETURN
4664 END IF
4665!
4666 CALL netcdf_get_time (ng, inlm, attfilename, 'Tstr', &
4667 & rclock%DateNumber, &
4668 & models(iroms)%ImportField(id)%Tstr, &
4669 & start=(/iroms,id,record/), &
4670 & total=(/1,1,1/))
4671 IF (founderror(exit_flag, noerror, __line__, &
4672 & myfile)) THEN
4673 rc=esmf_rc_file_read
4674 RETURN
4675 END IF
4676!
4677 CALL netcdf_get_time (ng, inlm, attfilename, 'Tend', &
4678 & rclock%DateNumber, &
4679 & models(iroms)%ImportField(id)%Tend, &
4680 & start=(/iroms,id,record/), &
4681 & total=(/1,1,1/))
4682 IF (founderror(exit_flag, noerror, __line__, &
4683 & myfile)) THEN
4684 rc=esmf_rc_file_read
4685 RETURN
4686 END IF
4687!
4688 CALL netcdf_get_time (ng, inlm, attfilename, 'Tintrp', &
4689 & rclock%DateNumber, &
4690 & models(iroms)%ImportField(id)%Tintrp(is), &
4691 & start=(/iroms,id,record/), &
4692 & total=(/1,1,1/))
4693 IF (founderror(exit_flag, noerror, __line__, &
4694 & myfile)) THEN
4695 rc=esmf_rc_file_read
4696 RETURN
4697 END IF
4698!
4699 CALL netcdf_get_time (ng, inlm, attfilename, 'Vtime', &
4700 & rclock%DateNumber, &
4701 & models(iroms)%ImportField(id)%Vtime(is), &
4702 & start=(/iroms,id,record/), &
4703 & total=(/1,1,1/))
4704 IF (founderror(exit_flag, noerror, __line__, &
4705 & myfile)) THEN
4706 rc=esmf_rc_file_read
4707 RETURN
4708 END IF
4709 CALL netcdf_get_time (ng, inlm, attfilename, 'Tmin', &
4710 & rclock%DateNumber, &
4711 & models(iroms)%ImportField(id)%Tmin, &
4712 & start=(/iroms,id,record/), &
4713 & total=(/1,1,1/))
4714 IF (founderror(exit_flag, noerror, __line__, &
4715 & myfile)) THEN
4716 rc=esmf_rc_file_read
4717 RETURN
4718 END IF
4719!
4720 CALL netcdf_get_time (ng, inlm, attfilename, 'Tmax', &
4721 & rclock%DateNumber, &
4722 & models(iroms)%ImportField(id)%Tmax, &
4723 & start=(/iroms,id,record/), &
4724 & total=(/1,1,1/))
4725 IF (founderror(exit_flag, noerror, __line__, &
4726 & myfile)) THEN
4727 rc=esmf_rc_file_read
4728 RETURN
4729 END IF
4730 END IF
4731# endif
4732!
4733! Get field pointer. Usually, the DO-loop is executed once since
4734! localDEcount=1.
4735!
4736 de_loop : DO localde=0,localdecount-1
4737 CALL esmf_fieldget (field, &
4738 & localde=localde, &
4739 & farrayptr=ptr2d, &
4740 & rc=rc)
4741 IF (esmf_logfounderror(rctocheck=rc, &
4742 & msg=esmf_logerr_passthru, &
4743 & line=__line__, &
4744 & file=myfile)) THEN
4745 RETURN
4746 END IF
4747
4748# ifdef TIME_INTERP_NOT_WORKING
4749!
4750! Retrieve custom Attribute Package.
4751!
4752 CALL esmf_attributegetattpack (field, &
4753 & 'CustomConvention', &
4754 & 'General', &
4755!! & 'Instance', &
4756 & attpack=attpack, &
4757 & ispresent=ispresent, &
4758 & rc=rc)
4759 IF (esmf_logfounderror(rctocheck=rc, &
4760 & msg=esmf_logerr_passthru, &
4761 & line=__line__, &
4762 & file=myfile)) THEN
4763 RETURN
4764 END IF
4765!
4766! Get field custom attribute for field for time interpolation.
4767!
4768 CALL esmf_attributeget (field, &
4769 & name='TimeInterp', &
4770 & valuelist=attvalues, &
4771 & attpack=attpack, &
4772 & ispresent=ispresent, &
4773 & rc=rc)
4774 IF (esmf_logfounderror(rctocheck=rc, &
4775 & msg=esmf_logerr_passthru, &
4776 & line=__line__, &
4777 & file=myfile)) THEN
4778 RETURN
4779 END IF
4780# endif
4781!
4782! Load import data into ROMS component variable.
4783# ifdef TIME_INTERP
4784! If time interpolating in ROMS kernel, loaded import data into
4785! snapshot storage arrays so time interpolating is carry out.
4786! It is a generic strategy for the case that coupling interval
4787! is greater than ROMS time-step size. Usually, time persisting
4788! of coupling data may alter ocean solution. For example, it may
4789! affect the ocean circulation/energetics if atmospheric forcing
4790! is persisted during infrequent coupling (like every 3, 6, or
4791! 24 hours and so on).
4792# endif
4793!
4794 loadit=.true.
4795 scale =models(iroms)%ImportField(id)%scale_factor
4796 add_offset =models(iroms)%ImportField(id)%add_offset
4797 tindex =models(iroms)%ImportField(id)%Tindex
4798# ifdef TIME_INTERP
4799 tmin =models(iroms)%ImportField(id)%Tmin
4800 tmax =models(iroms)%ImportField(id)%Tmax
4801 tstr =models(iroms)%ImportField(id)%Tstr
4802 tend =models(iroms)%ImportField(id)%Tend
4803 mytintrp(1)=models(iroms)%ImportField(id)%Tintrp(1)
4804 mytintrp(2)=models(iroms)%ImportField(id)%Tintrp(2)
4805 myvtime(1) =models(iroms)%ImportField(id)%Vtime(1)
4806 myvtime(2) =models(iroms)%ImportField(id)%Vtime(2)
4807 mydate(1) =models(iroms)%ImportField(id)%DateString(1)
4808 mydate(2) =models(iroms)%ImportField(id)%DateString(2)
4809# endif
4810!
4811! Set ROMS momentum fluxes and tracer flux scales to kinematic values.
4812! Recall, that all the fluxes are kinematic.
4813!
4814 freshwaterscale=1.0_dp/rho0 ! Kg m-2 s-1 to m/s
4815 stressscale=1.0_dp/rho0 ! Pa=N m-2 to m2/s2
4816 tracerfluxscale=1.0_dp/(rho0*cp) ! Watts m-2 to C m/s
4817!
4818 fval=ptr2d(istrr,jstrr)
4819 myfmin(1)= missing_dp
4820 myfmax(1)=-missing_dp
4821 myfmin(2)= missing_dp
4822 myfmax(2)=-missing_dp
4823!
4824 SELECT CASE (trim(adjustl(importnamelist(ifld))))
4825
4826# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
4827!
4828! Surface air pressure or mean sea level pressure (mb).
4829!
4830 CASE ('psfc', 'Pair', 'Pmsl')
4831 romsscale=scale
4832 ifield=idpair
4833 gtype=r2dvar
4834 tindex=3-iinfo(8,ifield,ng)
4835 DO j=jstrr,jendr
4836 DO i=istrr,iendr
4837 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4838 fval=scale*ptr2d(i,j)+add_offset
4839 ELSE
4840 fval=0.0_dp
4841 END IF
4842 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4843 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4844 myfmin(2)=min(myfmin(2),fval)
4845 myfmax(2)=max(myfmax(2),fval)
4846# ifdef TIME_INTERP
4847 forces(ng)%PairG(i,j,tindex)=fval
4848# else
4849 forces(ng)%Pair(i,j)=fval
4850# endif
4851 END DO
4852 END DO
4853# ifndef TIME_INTERP
4854 IF (localde.eq.localdecount-1) THEN
4855 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4856 CALL exchange_r2d_tile (ng, tile, &
4857 & lbi, ubi, lbj, ubj, &
4858 & forces(ng)%Pair)
4859 END IF
4860 CALL mp_exchange2d (ng, tile, inlm, 1, &
4861 & lbi, ubi, lbj, ubj, &
4862 & nghostpoints, &
4863 & ewperiodic(ng), nsperiodic(ng), &
4864 & forces(ng)%Pair)
4865 END IF
4866# endif
4867# endif
4868# if defined BULK_FLUXES || defined ECOSIM || \
4869 (defined shortwave && defined ana_srflux && defined albedo)
4870!
4871! Surface air temperature (Celsius).
4872!
4873 CASE ('tsfc', 'Tair')
4874 romsscale=scale
4875 ifield=idtair
4876 gtype=r2dvar
4877 tindex=3-iinfo(8,ifield,ng)
4878 DO j=jstrr,jendr
4879 DO i=istrr,iendr
4880 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4881 fval=scale*ptr2d(i,j)+add_offset
4882 ELSE
4883 fval=0.0_dp
4884 END IF
4885 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4886 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4887 myfmin(2)=min(myfmin(2),fval)
4888 myfmax(2)=max(myfmax(2),fval)
4889# ifdef TIME_INTERP
4890 forces(ng)%TairG(i,j,tindex)=fval
4891# else
4892 forces(ng)%Tair(i,j)=fval
4893# endif
4894 END DO
4895 END DO
4896# ifndef TIME_INTERP
4897 IF (localde.eq.localdecount-1) THEN
4898 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4899 CALL exchange_r2d_tile (ng, tile, &
4900 & lbi, ubi, lbj, ubj, &
4901 & forces(ng)%Tair)
4902 END IF
4903 CALL mp_exchange2d (ng, tile, inlm, 1, &
4904 & lbi, ubi, lbj, ubj, &
4905 & nghostpoints, &
4906 & ewperiodic(ng), nsperiodic(ng), &
4907 & forces(ng)%Tair)
4908 END IF
4909# endif
4910# endif
4911# if defined BULK_FLUXES || defined ECOSIM
4912!
4913! Surface air relative humidity (percentage). Notice that as the
4914! specific humidity, it is loaded to FORCES(ng)%Hair and "bulk_flux.F"
4915! will compute the specific humidity (kg/kg).
4916!
4917 CASE ('Qair')
4918 romsscale=scale
4919 ifield=idqair
4920 gtype=r2dvar
4921 tindex=3-iinfo(8,ifield,ng)
4922 DO j=jstrr,jendr
4923 DO i=istrr,iendr
4924 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4925 fval=scale*ptr2d(i,j)+add_offset
4926 ELSE
4927 fval=0.0_dp
4928 END IF
4929 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4930 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4931 myfmin(2)=min(myfmin(2),fval)
4932 myfmax(2)=max(myfmax(2),fval)
4933# ifdef TIME_INTERP
4934 forces(ng)%HairG(i,j,tindex)=fval
4935# else
4936 forces(ng)%Hair(i,j)=fval
4937# endif
4938 END DO
4939 END DO
4940# ifndef TIME_INTERP
4941 IF (localde.eq.localdecount-1) THEN
4942 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4943 CALL exchange_r2d_tile (ng, tile, &
4944 & lbi, ubi, lbj, ubj, &
4945 & forces(ng)%Hair)
4946 END IF
4947 CALL mp_exchange2d (ng, tile, inlm, 1, &
4948 & lbi, ubi, lbj, ubj, &
4949 & nghostpoints, &
4950 & ewperiodic(ng), nsperiodic(ng), &
4951 & forces(ng)%Hair)
4952 END IF
4953# endif
4954# endif
4955# if defined BULK_FLUXES
4956!
4957! Surface air specific humidity (kg kg-1).
4958!
4959 CASE ('Hair', 'qsfc')
4960 romsscale=scale
4961 ifield=idqair
4962 gtype=r2dvar
4963 tindex=3-iinfo(8,ifield,ng)
4964 DO j=jstrr,jendr
4965 DO i=istrr,iendr
4966 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4967 fval=scale*ptr2d(i,j)+add_offset
4968 ELSE
4969 fval=0.0_dp
4970 END IF
4971 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4972 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4973 myfmin(2)=min(myfmin(2),fval)
4974 myfmax(2)=max(myfmax(2),fval)
4975# ifdef TIME_INTERP
4976 forces(ng)%HairG(i,j,tindex)=fval
4977# else
4978 forces(ng)%Hair(i,j)=fval
4979# endif
4980 END DO
4981 END DO
4982# ifndef TIME_INTERP
4983 IF (localde.eq.localdecount-1) THEN
4984 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4985 CALL exchange_r2d_tile (ng, tile, &
4986 & lbi, ubi, lbj, ubj, &
4987 & forces(ng)%Hair)
4988 END IF
4989 CALL mp_exchange2d (ng, tile, inlm, 1, &
4990 & lbi, ubi, lbj, ubj, &
4991 & nghostpoints, &
4992 & ewperiodic(ng), nsperiodic(ng), &
4993 & forces(ng)%Hair)
4994 END IF
4995# endif
4996# endif
4997# if defined BULK_FLUXES
4998!
4999! Surface net longwave radiation (Celcius m s-1).
5000!
5001 CASE ('lwrd', 'LWrad')
5002 romsscale=tracerfluxscale
5003 ifield=idlrad
5004 gtype=r2dvar
5005 tindex=3-iinfo(8,ifield,ng)
5006 DO j=jstrr,jendr
5007 DO i=istrr,iendr
5008 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5009 fval=scale*ptr2d(i,j)+add_offset
5010 ELSE
5011 fval=0.0_dp
5012 END IF
5013 myfmin(1)=min(myfmin(1),fval)
5014 myfmax(1)=max(myfmax(1),fval)
5015 fval=fval*romsscale
5016 myfmin(2)=min(myfmin(2),fval)
5017 myfmax(2)=max(myfmax(2),fval)
5018# ifdef TIME_INTERP
5019 forces(ng)%lrflxG(i,j,tindex)=fval
5020# else
5021 forces(ng)%lrflx(i,j)=fval
5022# endif
5023 END DO
5024 END DO
5025# ifndef TIME_INTERP
5026 IF (localde.eq.localdecount-1) THEN
5027 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5028 CALL exchange_r2d_tile (ng, tile, &
5029 & lbi, ubi, lbj, ubj, &
5030 & forces(ng)%lrflx)
5031 END IF
5032 CALL mp_exchange2d (ng, tile, inlm, 1, &
5033 & lbi, ubi, lbj, ubj, &
5034 & nghostpoints, &
5035 & ewperiodic(ng), nsperiodic(ng), &
5036 & forces(ng)%lrflx)
5037 END IF
5038# endif
5039# endif
5040# if defined BULK_FLUXES && defined LONGWAVE_OUT
5041!
5042! Surface downward longwave radiation (Celcius m s-1). ROMS will
5043! substract the outgoing IR from model sea surface temperature.
5044!
5045 CASE ('dlwr', 'dLWrad', 'lwrad_down')
5046 romsscale=tracerfluxscale
5047 ifield=idldwn
5048 gtype=r2dvar
5049 tindex=3-iinfo(8,ifield,ng)
5050 DO j=jstrr,jendr
5051 DO i=istrr,iendr
5052 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5053 fval=scale*ptr2d(i,j)+add_offset
5054 ELSE
5055 fval=0.0_dp
5056 END IF
5057 myfmin(1)=min(myfmin(1),fval)
5058 myfmax(1)=max(myfmax(1),fval)
5059 fval=fval*romsscale
5060 myfmin(2)=min(myfmin(2),fval)
5061 myfmax(2)=max(myfmax(2),fval)
5062# ifdef TIME_INTERP
5063 forces(ng)%lrflxG(i,j,tindex)=fval
5064# else
5065 forces(ng)%lrflx(i,j)=fval
5066# endif
5067 END DO
5068 END DO
5069# ifndef TIME_INTERP
5070 IF (localde.eq.localdecount-1) THEN
5071 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5072 CALL exchange_r2d_tile (ng, tile, &
5073 & lbi, ubi, lbj, ubj, &
5074 & forces(ng)%lrflx)
5075 END IF
5076 CALL mp_exchange2d (ng, tile, inlm, 1, &
5077 & lbi, ubi, lbj, ubj, &
5078 & nghostpoints, &
5079 & ewperiodic(ng), nsperiodic(ng), &
5080 & forces(ng)%lrflx)
5081 END IF
5082# endif
5083# endif
5084# if defined BULK_FLUXES
5085!
5086! Rain fall rate (kg m-2 s-1).
5087!
5088 CASE ('prec', 'rain')
5089 romsscale=scale
5090 ifield=idrain
5091 gtype=r2dvar
5092 tindex=3-iinfo(8,ifield,ng)
5093 DO j=jstrr,jendr
5094 DO i=istrr,iendr
5095 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5096 fval=scale*ptr2d(i,j)+add_offset
5097 ELSE
5098 fval=0.0_dp
5099 END IF
5100 myfmin(1)=min(myfmin(1),ptr2d(i,j))
5101 myfmax(1)=max(myfmax(1),ptr2d(i,j))
5102 myfmin(2)=min(myfmin(2),fval)
5103 myfmax(2)=max(myfmax(2),fval)
5104# ifdef TIME_INTERP
5105 forces(ng)%rainG(i,j,tindex)=fval
5106# else
5107 forces(ng)%rain(i,j)=fval
5108# endif
5109 END DO
5110 END DO
5111# ifndef TIME_INTERP
5112 IF (localde.eq.localdecount-1) THEN
5113 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5114 CALL exchange_r2d_tile (ng, tile, &
5115 & lbi, ubi, lbj, ubj, &
5116 & forces(ng)%rain)
5117 END IF
5118 CALL mp_exchange2d (ng, tile, inlm, 1, &
5119 & lbi, ubi, lbj, ubj, &
5120 & nghostpoints, &
5121 & ewperiodic(ng), nsperiodic(ng), &
5122 & forces(ng)%rain)
5123 END IF
5124# endif
5125# endif
5126# if defined BULK_FLUXES || defined ECOSIM
5127!
5128! Surface eastward wind component (m s-1). Imported wind component
5129! is at RHO-points.
5130!
5131 CASE ('wndu', 'Uwind')
5132 IF (.not.allocated(uwind)) THEN
5133 allocate ( uwind(lbi:ubi,lbj:ubj) )
5134 uwind=missing_dp
5135 END IF
5136 got_wind(1)=.true.
5137 romsscale=scale
5138 ifield=iduair
5139 gtype=r2dvar
5140 tindex=3-iinfo(8,ifield,ng)
5141 DO j=jstrr,jendr
5142 DO i=istrr,iendr
5143 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5144 fval=scale*ptr2d(i,j)+add_offset
5145 ELSE
5146 fval=0.0_dp
5147 END IF
5148 myfmin(1)=min(myfmin(1),ptr2d(i,j))
5149 myfmax(1)=max(myfmax(1),ptr2d(i,j))
5150 myfmin(2)=min(myfmin(2),fval)
5151 myfmax(2)=max(myfmax(2),fval)
5152# ifdef TIME_INTERP
5153 forces(ng)%UwindG(i,j,tindex)=fval
5154# else
5155 uwind(i,j)=fval
5156# endif
5157 END DO
5158 END DO
5159# ifndef TIME_INTERP
5160 IF (localde.eq.localdecount-1) THEN
5161 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5162 CALL exchange_r2d_tile (ng, tile, &
5163 & lbi, ubi, lbj, ubj, &
5164 & uwind)
5165 END IF
5166 CALL mp_exchange2d (ng, tile, inlm, 1, &
5167 & lbi, ubi, lbj, ubj, &
5168 & nghostpoints, &
5169 & ewperiodic(ng), nsperiodic(ng), &
5170 & uwind)
5171 END IF
5172# endif
5173# endif
5174# if defined BULK_FLUXES || defined ECOSIM
5175!
5176! Surface northward wind component (m s-1). Imported wind component
5177! is at RHO-points.
5178!
5179 CASE ('wndv', 'Vwind')
5180 IF (.not.allocated(vwind)) THEN
5181 allocate ( vwind(lbi:ubi,lbj:ubj) )
5182 vwind=missing_dp
5183 END IF
5184 got_wind(2)=.true.
5185 romsscale=scale
5186 ifield=idvair
5187 gtype=r2dvar
5188 tindex=3-iinfo(8,ifield,ng)
5189 DO j=jstrr,jendr
5190 DO i=istrr,iendr
5191 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5192 fval=scale*ptr2d(i,j)+add_offset
5193 ELSE
5194 fval=0.0_dp
5195 END IF
5196 myfmin(1)=min(myfmin(1),ptr2d(i,j))
5197 myfmax(1)=max(myfmax(1),ptr2d(i,j))
5198 myfmin(2)=min(myfmin(2),fval)
5199 myfmax(2)=max(myfmax(2),fval)
5200# ifdef TIME_INTERP
5201 forces(ng)%VwindG(i,j,tindex)=fval
5202# else
5203 vwind(i,j)=fval
5204# endif
5205 END DO
5206 END DO
5207# ifndef TIME_INTERP
5208 IF (localde.eq.localdecount-1) THEN
5209 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5210 CALL exchange_r2d_tile (ng, tile, &
5211 & lbi, ubi, lbj, ubj, &
5212 & vwind)
5213 END IF
5214 CALL mp_exchange2d (ng, tile, inlm, 1, &
5215 & lbi, ubi, lbj, ubj, &
5216 & nghostpoints, &
5217 & ewperiodic(ng), nsperiodic(ng), &
5218 & vwind)
5219 END IF
5220# endif
5221# endif
5222# if defined SHORTWAVE
5223!
5224! Surface solar shortwave radiation (Celsius m s-1).
5225!
5226 CASE ('swrd', 'swrad', 'SWrad', 'SWrad_daily')
5227 romsscale=tracerfluxscale
5228 ifield=idsrad
5229 gtype=r2dvar
5230 tindex=3-iinfo(8,ifield,ng)
5231 DO j=jstrr,jendr
5232 DO i=istrr,iendr
5233 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5234 fval=scale*ptr2d(i,j)+add_offset
5235 ELSE
5236 fval=0.0_dp
5237 END IF
5238 myfmin(1)=min(myfmin(1),fval)
5239 myfmax(1)=max(myfmax(1),fval)
5240 fval=fval*romsscale
5241 myfmin(2)=min(myfmin(2),fval)
5242 myfmax(2)=max(myfmax(2),fval)
5243# ifdef TIME_INTERP
5244 forces(ng)%srflxG(i,j,tindex)=fval
5245# else
5246 forces(ng)%srflx(i,j)=fval
5247# endif
5248 END DO
5249 END DO
5250# ifndef TIME_INTERP
5251 IF (localde.eq.localdecount-1) THEN
5252 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5253 CALL exchange_r2d_tile (ng, tile, &
5254 & lbi, ubi, lbj, ubj, &
5255 & forces(ng)%srflx)
5256 END IF
5257 CALL mp_exchange2d (ng, tile, inlm, 1, &
5258 & lbi, ubi, lbj, ubj, &
5259 & nghostpoints, &
5260 & ewperiodic(ng), nsperiodic(ng), &
5261 & forces(ng)%srflx)
5262 END IF
5263# endif
5264# endif
5265# if !defined BULK_FLUXES
5266!
5267! Net longwave radiation flux(W m-2). Used for debugging and plotting
5268! purposes to check the fluxes used for the computation of the surface
5269! net heat flux in NUOPC cap file "esmf_atm.F".
5270!
5271 CASE ('lwr', 'LWrad')
5272 romsscale=tracerfluxscale
5273 ifield=idlrad
5274 gtype=r2dvar
5275 tindex=3-iinfo(8,ifield,ng)
5276 DO j=jstrr,jendr
5277 DO i=istrr,iendr
5278 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5279 fval=scale*ptr2d(i,j)+add_offset
5280 ELSE
5281 fval=0.0_dp
5282 END IF
5283 myfmin(1)=min(myfmin(1),fval)
5284 myfmax(1)=max(myfmax(1),fval)
5285 fval=fval*romsscale
5286 myfmin(2)=min(myfmin(2),fval)
5287 myfmax(2)=max(myfmax(2),fval)
5288 forces(ng)%lrflx(i,j)=fval
5289 END DO
5290 END DO
5291!
5292! Surface downward longwave radiation flux(W m-2). Used for debugging
5293! and plotting purposes to check the fluxes used for the computation
5294! of the surface net heat flux in NUOPC cap file "esmf_atm.F".
5295!
5296 CASE ('dlwr', 'dLWrad', 'lwrad_down')
5297 romsscale=tracerfluxscale
5298 ifield=idldwn
5299 gtype=r2dvar
5300 tindex=3-iinfo(8,ifield,ng)
5301 DO j=jstrr,jendr
5302 DO i=istrr,iendr
5303 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5304 fval=scale*ptr2d(i,j)+add_offset
5305 ELSE
5306 fval=0.0_dp
5307 END IF
5308 myfmin(1)=min(myfmin(1),fval)
5309 myfmax(1)=max(myfmax(1),fval)
5310 fval=fval*romsscale
5311 myfmin(2)=min(myfmin(2),fval)
5312 myfmax(2)=max(myfmax(2),fval)
5313 forces(ng)%lrflx(i,j)=fval
5314 END DO
5315 END DO
5316!
5317! Surface latent heat flux (W m-2). Used for plotting and debugging
5318! purposes (DebugLevel=3) to check the components of the net surface
5319! net heat flux computation.
5320!
5321 CASE ('latent', 'LHfx')
5322 romsscale=tracerfluxscale
5323 gtype=r2dvar
5324 DO j=jstrr,jendr
5325 DO i=istrr,iendr
5326 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5327 fval=scale*ptr2d(i,j)+add_offset
5328 ELSE
5329 fval=0.0_dp
5330 END IF
5331 myfmin(1)=min(myfmin(1),fval)
5332 myfmax(1)=max(myfmax(1),fval)
5333 fval=fval*romsscale
5334 myfmin(2)=min(myfmin(2),fval)
5335 myfmax(2)=max(myfmax(2),fval)
5336 forces(ng)%lhflx(i,j)=fval
5337 END DO
5338 END DO
5339!
5340! Surface sensible heat flux (W m-2). Used for plotting and debugging
5341! purposes (DebugLevel=3) to check the components of the net surface
5342! net heat flux computation.
5343!
5344 CASE ('sensible', 'SHfx')
5345 romsscale=tracerfluxscale
5346 gtype=r2dvar
5347 DO j=jstrr,jendr
5348 DO i=istrr,iendr
5349 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5350 fval=scale*ptr2d(i,j)+add_offset
5351 ELSE
5352 fval=0.0_dp
5353 END IF
5354 myfmin(1)=min(myfmin(1),fval)
5355 myfmax(1)=max(myfmax(1),fval)
5356 fval=fval*romsscale
5357 myfmin(2)=min(myfmin(2),fval)
5358 myfmax(2)=max(myfmax(2),fval)
5359 forces(ng)%shflx(i,j)=fval
5360 END DO
5361 END DO
5362!
5363! Surface net heat flux (Celsius m s-1).
5364!
5365 CASE ('nflx', 'shflux')
5366 romsscale=tracerfluxscale
5367 ifield=idtsur(itemp)
5368 gtype=r2dvar
5369 tindex=3-iinfo(8,ifield,ng)
5370 DO j=jstrr,jendr
5371 DO i=istrr,iendr
5372 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5373 fval=scale*ptr2d(i,j)+add_offset
5374 ELSE
5375 fval=0.0_dp
5376 END IF
5377 myfmin(1)=min(myfmin(1),fval)
5378 myfmax(1)=max(myfmax(1),fval)
5379 fval=fval*romsscale
5380 myfmin(2)=min(myfmin(2),fval)
5381 myfmax(2)=max(myfmax(2),fval)
5382# ifdef TIME_INTERP
5383 forces(ng)%stfluxG(i,j,tindex,itemp)=fval
5384# else
5385 forces(ng)%stflux(i,j,itemp)=fval
5386# endif
5387 END DO
5388 END DO
5389# ifndef TIME_INTERP
5390 IF (localde.eq.localdecount-1) THEN
5391 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5392 CALL exchange_r2d_tile (ng, tile, &
5393 & lbi, ubi, lbj, ubj, &
5394 & forces(ng)%stflux(:,:,itemp))
5395 END IF
5396 CALL mp_exchange2d (ng, tile, inlm, 1, &
5397 & lbi, ubi, lbj, ubj, &
5398 & nghostpoints, &
5399 & ewperiodic(ng), nsperiodic(ng), &
5400 & forces(ng)%stflux(:,:,itemp))
5401 END IF
5402# endif
5403# endif
5404# if !defined BULK_FLUXES && defined SALINITY
5405!
5406! Surface net freshwater flux: E-P (m s-1).
5407!
5408 CASE ('sflx', 'swflux')
5409 romsscale=freshwaterscale
5410 ifield=idtsur(isalt)
5411 gtype=r2dvar
5412 tindex=3-iinfo(8,ifield,ng)
5413 DO j=jstrr,jendr
5414 DO i=istrr,iendr
5415 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5416 fval=scale*ptr2d(i,j)+add_offset
5417 ELSE
5418 fval=0.0_dp
5419 END IF
5420 myfmin(1)=min(myfmin(1),fval)
5421 myfmax(1)=max(myfmax(1),fval)
5422 fval=fval*romsscale
5423 myfmin(2)=min(myfmin(2),fval)
5424 myfmax(2)=max(myfmax(2),fval)
5425# ifdef TIME_INTERP
5426 forces(ng)%stfluxG(i,j,tindex,isalt)=fval
5427# else
5428 forces(ng)%stflux(i,j,isalt)=fval
5429# endif
5430 END DO
5431 END DO
5432# ifndef TIME_INTERP
5433 IF (localde.eq.localdecount-1) THEN
5434 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5435 CALL exchange_r2d_tile (ng, tile, &
5436 & lbi, ubi, lbj, ubj, &
5437 & forces(ng)%stflux(:,:,isalt))
5438 END IF
5439 CALL mp_exchange2d (ng, tile, inlm, 1, &
5440 & lbi, ubi, lbj, ubj, &
5441 & nghostpoints, &
5442 & ewperiodic(ng), nsperiodic(ng), &
5443 & forces(ng)%stflux(:,:,isalt))
5444 END IF
5445# endif
5446# endif
5447# if !defined BULK_FLUXES
5448!
5449! Surface eastward wind stress component (m2 s-2). Imported stress
5450! component is at RHO-points.
5451!
5452 CASE ('taux', 'sustr')
5453 IF (.not.allocated(ustress)) THEN
5454 allocate ( ustress(lbi:ubi,lbj:ubj) )
5455 ustress=missing_dp
5456 END IF
5457 got_stress(1)=.true.
5458 romsscale=stressscale
5459 ifield=idusms
5460 gtype=u2dvar
5461 tindex=3-iinfo(8,ifield,ng)
5462 DO j=jstrr,jendr
5463 DO i=istrr,iendr
5464 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5465 fval=scale*ptr2d(i,j)+add_offset
5466 ELSE
5467 fval=0.0_dp
5468 END IF
5469 myfmin(1)=min(myfmin(1),fval)
5470 myfmax(1)=max(myfmax(1),fval)
5471 fval=fval*romsscale
5472 myfmin(2)=min(myfmin(2),fval)
5473 myfmax(2)=max(myfmax(2),fval)
5474# ifdef TIME_INTERP
5475 forces(ng)%sustrG(i,j,tindex)=fval
5476# else
5477 ustress(i,j)=fval
5478# endif
5479 END DO
5480 END DO
5481 IF (localde.eq.localdecount-1) THEN
5482 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5483 CALL exchange_r2d_tile (ng, tile, &
5484 & lbi, ubi, lbj, ubj, &
5485 & ustress)
5486 END IF
5487 CALL mp_exchange2d (ng, tile, inlm, 1, &
5488 & lbi, ubi, lbj, ubj, &
5489 & nghostpoints, &
5490 & ewperiodic(ng), nsperiodic(ng), &
5491 & ustress)
5492 END IF
5493# endif
5494# if !defined BULK_FLUXES
5495!
5496! Surface northward wind stress component (m2 s-2). Imported stress
5497! component is at RHO-points.
5498!
5499 CASE ('tauy', 'svstr')
5500 IF (.not.allocated(vstress)) THEN
5501 allocate ( vstress(lbi:ubi,lbj:ubj) )
5502 vstress=missing_dp
5503 END IF
5504 got_stress(2)=.true.
5505 romsscale=stressscale
5506 ifield=idvsms
5507 gtype=v2dvar
5508 tindex=3-iinfo(8,ifield,ng)
5509 DO j=jstrr,jendr
5510 DO i=istrr,iendr
5511 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5512 fval=scale*ptr2d(i,j)+add_offset
5513 ELSE
5514 fval=0.0_dp
5515 END IF
5516 myfmin(1)=min(myfmin(1),fval)
5517 myfmax(1)=max(myfmax(1),fval)
5518 fval=fval*romsscale
5519 myfmin(2)=min(myfmin(2),fval)
5520 myfmax(2)=max(myfmax(2),fval)
5521# ifdef TIME_INTERP
5522 forces(ng)%svstrG(i,j,tindex)=fval
5523# else
5524 vstress(i,j)=fval
5525# endif
5526 END DO
5527 END DO
5528 IF (localde.eq.localdecount-1) THEN
5529 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5530 CALL exchange_r2d_tile (ng, tile, &
5531 & lbi, ubi, lbj, ubj, &
5532 & vstress)
5533 END IF
5534 CALL mp_exchange2d (ng, tile, inlm, 1, &
5535 & lbi, ubi, lbj, ubj, &
5536 & nghostpoints, &
5537 & ewperiodic(ng), nsperiodic(ng), &
5538 & vstress)
5539 END IF
5540# endif
5541# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
5542!
5543! Surface air density (kg/m3).
5544!
5545 CASE ('RhoAir')
5546 IF (.not.allocated(rhoair)) THEN
5547 allocate ( rhoair(lbi:ubi,lbj:ubj) )
5548 rhoair=missing_dp
5549 END IF
5550 got_rhoair=.true.
5551 romsscale=scale
5552 DO j=jstrr,jendr
5553 DO i=istrr,iendr
5554 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5555 fval=scale*ptr2d(i,j)+add_offset
5556 ELSE
5557 fval=0.0_dp
5558 END IF
5559 myfmin(1)=min(myfmin(1),fval)
5560 myfmax(1)=max(myfmax(1),fval)
5561 fval=fval*romsscale
5562 myfmin(2)=min(myfmin(2),fval)
5563 myfmax(2)=max(myfmax(2),fval)
5564 rhoair(i,j)=fval
5565 END DO
5566 END DO
5567 IF (localde.eq.localdecount-1) THEN
5568 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5569 CALL exchange_r2d_tile (ng, tile, &
5570 & lbi, ubi, lbj, ubj, &
5571 & rhoair)
5572 END IF
5573 CALL mp_exchange2d (ng, tile, inlm, 1, &
5574 & lbi, ubi, lbj, ubj, &
5575 & nghostpoints, &
5576 & ewperiodic(ng), nsperiodic(ng), &
5577 & rhoair)
5578 END IF
5579!
5580! Eastward wind component (m s-1) at surface boundary layer. Imported
5581! wind component is at RHO-points.
5582!
5583 CASE ('Uwind_sbl')
5584 IF (.not.allocated(xwind)) THEN
5585 allocate ( xwind(lbi:ubi,lbj:ubj) )
5586 xwind=missing_dp
5587 END IF
5588 got_wind_sbl(1)=.true.
5589 romsscale=scale
5590 DO j=jstrr,jendr
5591 DO i=istrr,iendr
5592 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5593 fval=scale*ptr2d(i,j)+add_offset
5594 ELSE
5595 fval=0.0_dp
5596 END IF
5597 myfmin(1)=min(myfmin(1),ptr2d(i,j))
5598 myfmax(1)=max(myfmax(1),ptr2d(i,j))
5599 fval=fval*romsscale
5600 myfmin(2)=min(myfmin(2),fval)
5601 myfmax(2)=max(myfmax(2),fval)
5602 xwind(i,j)=fval
5603 END DO
5604 END DO
5605 IF (localde.eq.localdecount-1) THEN
5606 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5607 CALL exchange_r2d_tile (ng, tile, &
5608 & lbi, ubi, lbj, ubj, &
5609 & xwind)
5610 END IF
5611 CALL mp_exchange2d (ng, tile, inlm, 1, &
5612 & lbi, ubi, lbj, ubj, &
5613 & nghostpoints, &
5614 & ewperiodic(ng), nsperiodic(ng), &
5615 & xwind)
5616 END IF
5617!
5618! Northward wind component (m s-1) at surface boundary layer. Imported
5619! wind component is at RHO-points.
5620!
5621 CASE ('Vwind_sbl')
5622 IF (.not.allocated(ywind)) THEN
5623 allocate ( ywind(lbi:ubi,lbj:ubj) )
5624 ywind=missing_dp
5625 END IF
5626 got_wind_sbl(2)=.true.
5627 romsscale=scale
5628 DO j=jstrr,jendr
5629 DO i=istrr,iendr
5630 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5631 fval=scale*ptr2d(i,j)+add_offset
5632 ELSE
5633 fval=0.0_dp
5634 END IF
5635 myfmin(1)=min(myfmin(1),ptr2d(i,j))
5636 myfmax(1)=max(myfmax(1),ptr2d(i,j))
5637 fval=fval*romsscale
5638 myfmin(2)=min(myfmin(2),fval)
5639 myfmax(2)=max(myfmax(2),fval)
5640 ywind(i,j)=fval
5641 END DO
5642 END DO
5643 IF (localde.eq.localdecount-1) THEN
5644 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5645 CALL exchange_r2d_tile (ng, tile, &
5646 & lbi, ubi, lbj, ubj, &
5647 & ywind)
5648 END IF
5649 CALL mp_exchange2d (ng, tile, inlm, 1, &
5650 & lbi, ubi, lbj, ubj, &
5651 & nghostpoints, &
5652 & ewperiodic(ng), nsperiodic(ng), &
5653 & ywind)
5654 END IF
5655!
5656! Surface frictional wind magnitude (m s-1) from similarity theory.
5657! Imported wind magnitude is at RHO-points.
5658!
5659 CASE ('Wstar')
5660 IF (.not.allocated(wstar)) THEN
5661 allocate ( wstar(lbi:ubi,lbj:ubj) )
5662 wstar=missing_dp
5663 END IF
5664 got_wstar=.true.
5665 romsscale=scale
5666 DO j=jstrr,jendr
5667 DO i=istrr,iendr
5668 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
5669 fval=scale*ptr2d(i,j)+add_offset
5670 ELSE
5671 fval=0.0_dp
5672 END IF
5673 myfmin(1)=min(myfmin(1),ptr2d(i,j))
5674 myfmax(1)=max(myfmax(1),ptr2d(i,j))
5675 fval=fval*romsscale
5676 myfmin(2)=min(myfmin(2),fval)
5677 myfmax(2)=max(myfmax(2),fval)
5678 wstar(i,j)=fval
5679 END DO
5680 END DO
5681 IF (localde.eq.localdecount-1) THEN
5682 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5683 CALL exchange_r2d_tile (ng, tile, &
5684 & lbi, ubi, lbj, ubj, &
5685 & wstar)
5686 END IF
5687 CALL mp_exchange2d (ng, tile, inlm, 1, &
5688 & lbi, ubi, lbj, ubj, &
5689 & nghostpoints, &
5690 & ewperiodic(ng), nsperiodic(ng), &
5691 & wstar)
5692 END IF
5693# endif
5694!
5695! Import field not found.
5696!
5697 CASE DEFAULT
5698 IF (localpet.eq.0) THEN
5699 WRITE (cplout,10) trim(importnamelist(ifld)), &
5700 & trim(time_currentstring), &
5701 & trim(cplname)
5702 END IF
5703 exit_flag=9
5704 IF (founderror(exit_flag, noerror, __line__, &
5705 & myfile)) THEN
5706 rc=esmf_rc_not_found
5707 RETURN
5708 END IF
5709 END SELECT
5710!
5711! Print pointer information.
5712!
5713 IF (debuglevel.eq.4) THEN
5714 WRITE (cplout,20) localpet, localde, &
5715 & lbound(ptr2d,dim=1), ubound(ptr2d,dim=1), &
5716 & lbound(ptr2d,dim=2), ubound(ptr2d,dim=2), &
5717 & istrr, iendr, jstrr, jendr
5718 END IF
5719!
5720! Nullify pointer to make sure that it does not point on a random
5721! part in the memory.
5722!
5723 IF (associated(ptr2d)) nullify (ptr2d)
5724 END DO de_loop
5725!
5726! Get import field minimun and maximum values.
5727!
5728 CALL esmf_vmallreduce (vm, &
5729 & senddata=myfmin, &
5730 & recvdata=fmin, &
5731 & count=2, &
5732 & reduceflag=esmf_reduce_min, &
5733 & rc=rc)
5734 IF (esmf_logfounderror(rctocheck=rc, &
5735 & msg=esmf_logerr_passthru, &
5736 & line=__line__, &
5737 & file=myfile)) THEN
5738 RETURN
5739 END IF
5740!
5741 CALL esmf_vmallreduce (vm, &
5742 & senddata=myfmax, &
5743 & recvdata=fmax, &
5744 & count=2, &
5745 & reduceflag=esmf_reduce_max, &
5746 & rc=rc)
5747 IF (esmf_logfounderror(rctocheck=rc, &
5748 & msg=esmf_logerr_passthru, &
5749 & line=__line__, &
5750 & file=myfile)) THEN
5751 RETURN
5752 END IF
5753!
5754! Write out import field information.
5755!
5756 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
5757 WRITE (cplout,30) trim(importnamelist(ifld)), &
5758# ifdef TIME_INTERP
5759 & trim(mydate(tindex)), ng, &
5760 & fmin(1), fmax(1), tindex
5761# else
5762 & trim(time_currentstring), ng, &
5763 & fmin(1), fmax(1)
5764# endif
5765 IF (romsscale.ne.1.0_dp) THEN
5766 WRITE (cplout,40) fmin(2), fmax(2), &
5767 & ' romsScale = ', romsscale
5768 ELSE IF (add_offset.ne.0.0_dp) THEN
5769 WRITE (cplout,40) fmin(2), fmax(2), &
5770 & ' AddOffset = ', add_offset
5771 END IF
5772 END IF
5773
5774# ifdef TIME_INTERP
5775!
5776! Load ROMS metadata information needed for time interpolation and
5777! reporting.
5778!
5779 IF (loadit) THEN
5780 linfo(1,ifield,ng)=.true. ! Lgrided
5781 linfo(3,ifield,ng)=.false. ! Lonerec
5782 iinfo(1,ifield,ng)=gtype
5783 iinfo(8,ifield,ng)=tindex
5784 finfo(1,ifield,ng)=tmin
5785 finfo(2,ifield,ng)=tmax
5786 finfo(3,ifield,ng)=tstr
5787 finfo(4,ifield,ng)=tend
5788 finfo(8,ifield,ng)=fmin(1)
5789 finfo(9,ifield,ng)=fmax(1)
5790 vtime(tindex,ifield,ng)=myvtime(tindex)
5791 tintrp(tindex,ifield,ng)=mytintrp(tindex)*86400.0_dp
5792 END IF
5793# endif
5794!
5795! Debugging: write out import field into NetCDF file.
5796!
5797 IF ((debuglevel.ge.3).and. &
5798 & models(iroms)%ImportField(id)%debug_write) THEN
5799 WRITE (ofile,50) ng, trim(importnamelist(ifld)), &
5800 & year, month, day, hour, minutes, seconds
5801 CALL esmf_fieldwrite (field, &
5802 & trim(ofile), &
5803 & overwrite=.true., &
5804 & rc=rc)
5805 IF (esmf_logfounderror(rctocheck=rc, &
5806 & msg=esmf_logerr_passthru, &
5807 & line=__line__, &
5808 & file=myfile)) THEN
5809 RETURN
5810 END IF
5811 END IF
5812
5813 END DO fld_loop
5814
5815# if defined BULK_FLUXES || defined ECOSIM
5816!
5817! If applicable, rotate wind components to ROMS curvilinear grid.
5818!
5819 IF (got_wind(1).and.got_wind(2)) THEN
5820 CALL roms_rotate (ng, tile, geo2grid_rho, &
5821 & lbi, ubi, lbj, ubj, &
5822 & uwind, vwind, &
5823 & forces(ng)%Uwind, forces(ng)%Vwind)
5824 deallocate (uwind)
5825 deallocate (vwind)
5826 END IF
5827# endif
5828# if !defined BULK_FLUXES
5829!
5830! If applicable, rotate wind stress components to ROMS curvilinear
5831! grid.
5832!
5833 IF (got_stress(1).and.got_stress(2)) THEN
5834 CALL roms_rotate (ng, tile, geo2grid, &
5835 & lbi, ubi, lbj, ubj, &
5836 & ustress, vstress, &
5837 & forces(ng)%sustr, forces(ng)%svstr)
5838 deallocate (ustress)
5839 deallocate (vstress)
5840 END IF
5841# endif
5842# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
5843!
5844! If applicable, compute surface wind stress components. The surface
5845! ocean currents are substracted to the wind.
5846!
5847! The wind stress component are computed as:
5848!
5849! taux/rho0 = RhoAir * Cd * Wrel * Urel
5850! tauy/rho0 = RhoAir * Cd * Wrel * Vrel
5851! where
5852! Cd = Wstr**2 / Wmag**2
5853!
5854! so the magnitude is diminished by the weaker relative (wind minus
5855! current) components. The coupling is incompleate becasue there is
5856! not feeback to the atmosphere (wind is not modified by currents).
5857!
5858 myfmin= missing_dp
5859 myfmax=-missing_dp
5860!
5861 IF (got_rhoair.and.got_wstar.and. &
5862 & got_wind_sbl(1).and.got_wind_sbl(2)) THEN
5863 IF (.not.allocated(uwrk)) THEN
5864 allocate ( uwrk(lbi:ubi,lbj:ubj) )
5865 uwrk=missing_dp
5866 END IF
5867 IF (.not.allocated(vwrk)) THEN
5868 allocate ( vwrk(lbi:ubi,lbj:ubj) )
5869 vwrk=missing_dp
5870 END IF
5871!
5872 CALL roms_rotate (ng, tile, grid2geo_rho, &
5873 & lbi, ubi, lbj, ubj, &
5874 & ocean(ng)%u(:,:,n(ng),nstp(ng)), &
5875 & ocean(ng)%v(:,:,n(ng),nstp(ng)), &
5876 & uwrk, vwrk) ! rotated currents to E-N
5877!
5878 DO j=jstr-1,jend+1
5879 DO i=istr-1,iend+1
5880 romsscale=stressscale ! m3/kg
5881 urel=xwind(i,j)-uwrk(i,j) ! relative wind:
5882 vrel=ywind(i,j)-vwrk(i,j) ! wind minus current
5883 wmag=sqrt(xwind(i,j)*xwind(i,j)+ &
5884 & ywind(i,j)*ywind(i,j)) ! ATM wind magnitude
5885 wrel=sqrt(urel*urel+vrel*vrel) ! relative magmitude
5886 cff1=romsscale*rhoair(i,j)
5887 cff2=wstar(i,j)*wstar(i,j)/(wmag*wmag+eps)
5888 cff3=cff1*cff2*wrel ! m/s
5889 uwrk(i,j)=cff3*urel ! m2/s2
5890 vwrk(i,j)=cff3*vrel ! m2/s2
5891 myfmin(1)=min(myfmin(1),uwrk(i,j))
5892 myfmin(2)=min(myfmin(2),vwrk(i,j))
5893 myfmax(1)=max(myfmax(1),uwrk(i,j))
5894 myfmax(2)=max(myfmax(2),vwrk(i,j))
5895 END DO
5896 END DO
5897 deallocate (rhoair)
5898 deallocate (wstar)
5899 deallocate (xwind)
5900 deallocate (ywind)
5901! ! rotate stress to grid
5902 CALL roms_rotate (ng, tile, geo2grid, &
5903 & lbi, ubi, lbj, ubj, &
5904 & uwrk, vwrk, &
5905 & forces(ng)%sustr, &
5906 & forces(ng)%svstr)
5907 deallocate (uwrk)
5908 deallocate (vwrk)
5909!
5910! Report computed wind stress minimum and maximum values.
5911!
5912 IF (debuglevel.ge.0) THEN
5913 CALL esmf_vmallreduce (vm, &
5914 & senddata=myfmin, &
5915 & recvdata=fmin, &
5916 & count=2, &
5917 & reduceflag=esmf_reduce_min, &
5918 & rc=rc)
5919 IF (esmf_logfounderror(rctocheck=rc, &
5920 & msg=esmf_logerr_passthru, &
5921 & line=__line__, &
5922 & file=myfile)) THEN
5923 RETURN
5924 END IF
5925!
5926 CALL esmf_vmallreduce (vm, &
5927 & senddata=myfmax, &
5928 & recvdata=fmax, &
5929 & count=2, &
5930 & reduceflag=esmf_reduce_max, &
5931 & rc=rc)
5932 IF (esmf_logfounderror(rctocheck=rc, &
5933 & msg=esmf_logerr_passthru, &
5934 & line=__line__, &
5935 & file=myfile)) THEN
5936 RETURN
5937 END IF
5938!
5939 IF (localpet.eq.0) THEN
5940 WRITE (cplout,60) 'sustr', &
5941 & trim(time_currentstring), ng, &
5942 & fmin(1)/stressscale, &
5943 & fmax(1)/stressscale
5944 WRITE (cplout,40) fmin(1), fmax(1), &
5945 & ' romsScale = ', stressscale
5946!
5947 WRITE (cplout,60) 'svstr', &
5948 & trim(time_currentstring), ng, &
5949 & fmin(2)/stressscale, &
5950 & fmax(2)/stressscale
5951 WRITE (cplout,40) fmin(2), fmax(2), &
5952 & ' romsScale = ', stressscale
5953 END IF
5954 END IF
5955 END IF
5956# endif
5957!
5958! Deallocate local arrays.
5959!
5960 IF (allocated(importnamelist)) deallocate (importnamelist)
5961!
5962! Update ROMS import calls counter.
5963!
5964 IF (importcount.gt.0) THEN
5965 models(iroms)%ImportCalls=models(iroms)%ImportCalls+1
5966 END IF
5967!
5968 IF (esm_track) THEN
5969 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Import', &
5970 & ', PET', petrank
5971 FLUSH (trac)
5972 END IF
5973 IF (debuglevel.gt.0) FLUSH (cplout)
5974!
5975 10 FORMAT (/,3x,' ROMS_Import - unable to find option to import: ', &
5976 & a,t72,a,/,18x,'check ''Import(roms)'' in input script: ', &
5977 & a)
5978 20 FORMAT (18x,'PET/DE [',i3.3,'/',i2.2,'], Pointer Size: ',4i8, &
5979 & /,36x,'Tiling Range: ',4i8)
5980 30 FORMAT (3x,' ROMS_Import - ESMF: importing field ''',a,'''', &
5981 & t72,a,2x,'Grid ',i2.2, &
5982# ifdef TIME_INTERP
5983 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
5984 & ' SnapshotIndex = ',i1,')')
5985# else
5986 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
5987 & ')')
5988# endif
5989 40 FORMAT (19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
5990 & 1x,a,1p,e15.8,0p,')')
5991 50 FORMAT ('roms_',i2.2,'_import_',a,'_',i4.4,2('-',i2.2),'_', &
5992 & i2.2,2('.',i2.2),'.nc')
5993 60 FORMAT (3x,' ROMS_Import - ESMF: computing field ''',a,'''', &
5994 & t72,a,2x,'Grid ',i2.2, &
5995 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
5996 & ')')
5997!
5998 RETURN

References mod_param::bounds, mod_scalars::cp, cplname, cplout, debuglevel, mod_kinds::dp, esm_track, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_scalars::exit_flag, 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, iroms, mod_scalars::isalt, mod_scalars::itemp, mod_ncparam::linfo, missing_dp, mod_param::mm, models, mp_exchange_mod::mp_exchange2d(), mod_param::n, mod_param::nghostpoints, mod_scalars::noerror, mod_scalars::nsperiodic, mod_stepping::nstp, mod_ocean::ocean, petlayoutoption, petrank, mod_param::r2dvar, mod_scalars::rclock, mod_scalars::rho0, dateclock_mod::roms_clock(), roms_rotate(), mod_iounits::sourcefile, mod_ncparam::tintrp, tol_dp, 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 cmeps_roms_mod::roms_modeladvance ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 4040 of file cmeps_roms.h.

4041!
4042!=======================================================================
4043! !
4044! Advance ROMS component for a coupling interval (seconds) using !
4045! "ROMS_run". It also calls "ROMS_Import" and "ROMS_Export" to !
4046! import and export coupling fields, respectively. !
4047! !
4048! During configuration, the driver clock was decreased by a single !
4049! coupling interval (TimeStep) to allow the proper initialization !
4050! of the import and export fields pointers. ROMS is not advanced !
4051! on the first call to this routine, so the time stepping is over !
4052! the specified application start and ending dates. !
4053! !
4054# if defined TIME_INTERP
4055! On the first pass, it imports the LOWER time snapshot fields, !
4056! but cannot time-step ROMS until the next call after importing !
4057! the UPPER snapshot. Therefore, it starts time-stepping when !
4058! both LOWER and UPPER time snapshot fields are exchanged so that !
4059! ROMS can perform time interpolation. !
4060# else
4061! ROMS is actually advanced on the second call to this routine. !
4062# endif
4063! !
4064!=======================================================================
4065!
4066! Imported variable declarations.
4067!
4068 integer, intent(out) :: rc
4069!
4070 TYPE (ESMF_GridComp) :: model
4071!
4072! Local variable declarations.
4073!
4074 logical :: Ladvance
4075 integer :: is, ng
4076 integer :: MyTask, PETcount, localPET, phase
4077!
4078 real (dp) :: CouplingInterval, RunInterval
4079 real (dp) :: TcurrentInSeconds, TstopInSeconds
4080!
4081 character (len=22) :: Cinterval
4082 character (len=22) :: CurrTimeString, StopTimeString
4083
4084 character (len=*), parameter :: MyFile = &
4085 & __FILE__//", ROMS_SetModelAdvance"
4086!
4087 TYPE (ESMF_Clock) :: clock
4088 TYPE (ESMF_State) :: ExportState, ImportState
4089 TYPE (ESMF_Time) :: ReferenceTime
4090 TYPE (ESMF_Time) :: CurrentTime, StopTime
4091 TYPE (ESMF_TimeInterval) :: TimeStep
4092 TYPE (ESMF_VM) :: vm
4093!
4094!-----------------------------------------------------------------------
4095! Initialize return code flag to success state (no error).
4096!-----------------------------------------------------------------------
4097!
4098 IF (esm_track) THEN
4099 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_ModelAdvance', &
4100 & ', PET', petrank
4101 FLUSH (trac)
4102 END IF
4103 rc=esmf_success
4104!
4105!-----------------------------------------------------------------------
4106! Get information about the gridded component.
4107!-----------------------------------------------------------------------
4108!
4109! Inquire about ROMS component.
4110!
4111 CALL esmf_gridcompget (model, &
4112 & importstate=importstate, &
4113 & exportstate=exportstate, &
4114 & clock=clock, &
4115 & localpet=localpet, &
4116 & petcount=petcount, &
4117 & currentphase=phase, &
4118 & vm=vm, &
4119 & rc=rc)
4120 IF (esmf_logfounderror(rctocheck=rc, &
4121 & msg=esmf_logerr_passthru, &
4122 & line=__line__, &
4123 & file=myfile)) THEN
4124 RETURN
4125 END IF
4126!
4127! Get time step interval, stopping time, reference time, and current
4128! time.
4129!
4130 CALL esmf_clockget (clock, &
4131 & timestep=timestep, &
4132 & stoptime=stoptime, &
4133 & reftime=referencetime, &
4134 & currtime=clockinfo(iroms)%CurrentTime, &
4135 & rc=rc)
4136 IF (esmf_logfounderror(rctocheck=rc, &
4137 & msg=esmf_logerr_passthru, &
4138 & line=__line__, &
4139 & file=myfile)) THEN
4140 RETURN
4141 END IF
4142!
4143! Current ROMS time (seconds).
4144!
4145 CALL esmf_timeget (clockinfo(iroms)%CurrentTime, &
4146 & s_r8=tcurrentinseconds, &
4147 & timestringisofrac=currtimestring, &
4148 & rc=rc)
4149 IF (esmf_logfounderror(rctocheck=rc, &
4150 & msg=esmf_logerr_passthru, &
4151 & line=__line__, &
4152 & file=myfile)) THEN
4153 RETURN
4154 END IF
4155 is=index(currtimestring, 'T') ! remove 'T' in
4156 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
4157!
4158! ROMS stop time (seconds) for this coupling window.
4159!
4160 CALL esmf_timeget (clockinfo(iroms)%CurrentTime+timestep, &
4161 & s_r8=tstopinseconds, &
4162 & timestringisofrac=stoptimestring, &
4163 & rc=rc)
4164 IF (esmf_logfounderror(rctocheck=rc, &
4165 & msg=esmf_logerr_passthru, &
4166 & line=__line__, &
4167 & file=myfile)) THEN
4168 RETURN
4169 END IF
4170 is=index(stoptimestring, 'T') ! remove 'T' in
4171 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
4172!
4173! Get coupling time interval (seconds, double precision).
4174!
4175 CALL esmf_timeintervalget (timestep, &
4176 & s_r8=couplinginterval, &
4177 & rc=rc)
4178 IF (esmf_logfounderror(rctocheck=rc, &
4179 & msg=esmf_logerr_passthru, &
4180 & line=__line__, &
4181 & file=myfile)) THEN
4182 RETURN
4183 END IF
4184!
4185! Set ROMS running interval (seconds) for the current coupling window.
4186!
4187 runinterval=couplinginterval
4188!
4189! Set local model advance time stepping switch.
4190!
4191 ladvance=.true.
4192# ifdef TIME_INTERP
4193 IF ((models(iroms)%ImportCalls.eq.0).and. &
4194 & (nimport(iroms).gt.0)) THEN
4195 ladvance=.false.
4196 END IF
4197# else
4198# ifdef REGRESS_STARTCLOCK
4199 IF (tcurrentinseconds.eq.clockinfo(idriver)%Time_Start) THEN
4200 ladvance=.false.
4201 END IF
4202# endif
4203# endif
4204!
4205!-----------------------------------------------------------------------
4206! Report time information strings (YYYY-MM-DD hh:mm:ss).
4207!-----------------------------------------------------------------------
4208!
4209 IF (localpet.eq.0) THEN
4210 WRITE (cinterval,'(f15.2)') couplinginterval
4211 WRITE (cplout,10) trim(currtimestring), trim(stoptimestring), &
4212 & trim(adjustl(cinterval)), ladvance
4213 END IF
4214!
4215!-----------------------------------------------------------------------
4216! Get import fields from other ESM components.
4217!-----------------------------------------------------------------------
4218!
4219 IF (nimport(iroms).gt.0) THEN
4220 DO ng=1,models(iroms)%Ngrids
4221 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
4222 CALL roms_import (ng, model, rc)
4223 IF (esmf_logfounderror(rctocheck=rc, &
4224 & msg=esmf_logerr_passthru, &
4225 & line=__line__, &
4226 & file=myfile)) THEN
4227 RETURN
4228 END IF
4229 END IF
4230 END DO
4231 END IF
4232!
4233!-----------------------------------------------------------------------
4234! Run ROMS component. Notice that ROMS component is advanced when
4235! ng=1. In nested application, ROMS kernel (main2d or main3d) will
4236! advance all the nested grid in their logical order. In nesting,
4237! the execution order of the grids is critical since nesting is
4238! two-way by default.
4239!-----------------------------------------------------------------------
4240!
4241 IF (ladvance) THEN
4242 IF (esm_track) THEN
4243 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Run', &
4244 & ', PET', petrank
4245 FLUSH (trac)
4246 END IF
4247 CALL roms_run (runinterval)
4248 IF (esm_track) THEN
4249 WRITE (trac,'(a,a,i0)') '==> Exiting ROMS_Run', &
4250 & ', PET', petrank
4251 FLUSH (trac)
4252 END IF
4253 END IF
4254!
4255 IF (exit_flag.ne.noerror) then
4256 IF (localpet.eq.0) then
4257 WRITE (cplout,'(a,i1)') 'ROMS component exit with flag = ', &
4258 & exit_flag
4259 END IF
4260 CALL roms_finalize
4261 CALL esmf_finalize (endflag=esmf_end_abort)
4262 END IF
4263!
4264!-----------------------------------------------------------------------
4265! Put export fields.
4266!-----------------------------------------------------------------------
4267!
4268 IF (nexport(iroms).gt.0) THEN
4269 DO ng=1,models(iroms)%Ngrids
4270 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
4271 CALL roms_export (ng, model, rc)
4272 IF (esmf_logfounderror(rctocheck=rc, &
4273 & msg=esmf_logerr_passthru, &
4274 & line=__line__, &
4275 & file=myfile)) THEN
4276 RETURN
4277 END IF
4278 END IF
4279 END DO
4280 END IF
4281!
4282 IF (esm_track) THEN
4283 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_ModelAdvance', &
4284 & ', PET', petrank
4285 FLUSH (trac)
4286 END IF
4287!
4288 10 FORMAT (3x,'ModelAdvance - ESMF, Running ROMS:',t42,a, &
4289 & ' => ',a,', [',a,' s], Advance: ',l1)
4290!
4291 RETURN

References clockinfo, coupled, cplout, esm_track, mod_scalars::exit_flag, idriver, iroms, models, nexport, nimport, mod_scalars::noerror, petrank, roms_export(), roms_kernel_mod::roms_finalize(), roms_import(), roms_kernel_mod::roms_run(), and 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 cmeps_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 6539 of file cmeps_roms.h.

6543!
6544!=======================================================================
6545! !
6546! It rotates exchanged vector components from computational grid to !
6547! geographical EAST and NORTH directions or vice versa acccording to !
6548! Lrotate flag: !
6549! !
6550! Lrotate = geo2grid_rho RHO-points rotation !
6551! Lrotate = grid2geo_rho Exporting interior RHO-points !
6552! Lrotate = geo2grid U- and V-points staggered rotation !
6553! !
6554!=======================================================================
6555!
6556! Imported variable declarations.
6557!
6558 integer, intent(in) :: ng, tile, Lrotate
6559 integer, intent(in) :: LBi, UBi, LBj, UBj
6560!
6561 real (dp), intent(in) :: Uinp(LBi:UBi,LBj:UBj)
6562 real (dp), intent(in) :: Vinp(LBi:UBi,LBj:UBj)
6563 real (r8), intent(out) :: Uout(LBi:UBi,LBj:UBj)
6564 real (r8), intent(out) :: Vout(LBi:UBi,LBj:UBj)
6565!
6566! Local variable declarations.
6567!
6568 integer :: i, j
6569 integer :: IstrR, IendR, JstrR, JendR
6570 integer :: Istr, Iend, Jstr, Jend
6571!
6572 real :: Urho, Vrho
6573!
6574 real (r8) :: Urot(LBi:UBi,LBj:UBj)
6575 real (r8) :: Vrot(LBi:UBi,LBj:UBj)
6576!
6577!-----------------------------------------------------------------------
6578! Initialize.
6579!-----------------------------------------------------------------------
6580!
6581 IF (esm_track) THEN
6582 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Rotate', &
6583 & ', PET', petrank
6584 FLUSH (trac)
6585 END IF
6586!
6587! Set horizontal tile bounds.
6588!
6589 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
6590 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
6591 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
6592 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
6593!
6594 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
6595 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
6596 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
6597 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
6598
6599# ifdef CURVGRID
6600!
6601!-----------------------------------------------------------------------
6602! Rotate from geographical (EAST, NORTH) to computational grid
6603! directions (ROMS import case).
6604!-----------------------------------------------------------------------
6605!
6606 IF ((lrotate.eq.geo2grid).or.(lrotate.eq.geo2grid_rho)) THEN
6607 DO j=jstrr,jendr
6608 DO i=istrr,iendr
6609 urot(i,j)=uinp(i,j)*grid(ng)%CosAngler(i,j)+ &
6610 & vinp(i,j)*grid(ng)%SinAngler(i,j)
6611 vrot(i,j)=vinp(i,j)*grid(ng)%CosAngler(i,j)- &
6612 & uinp(i,j)*grid(ng)%SinAngler(i,j)
6613 END DO
6614 END DO
6615!
6616! There is an option to import the rotated vector to staggered U- and
6617! V-locations (arithmetic avererage) or import vector at its native
6618! cell center (RHO-points).
6619!
6620 IF (lrotate.eq.geo2grid_rho) THEN ! RHO-points
6621 DO j=jstrr,jendr
6622 DO i=istrr,iendr
6623 uout(i,j)=urot(i,j)
6624 vout(i,j)=vrot(i,j)
6625 END DO
6626 END DO
6627!
6628 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
6629 CALL exchange_r2d_tile (ng, tile, &
6630 & lbi, ubi, lbj, ubj, &
6631 & uout)
6632 CALL exchange_r2d_tile (ng, tile, &
6633 & lbi, ubi, lbj, ubj, &
6634 & vout)
6635 END IF
6636
6637 ELSE IF (lrotate.eq.geo2grid) THEN ! U- and V-points
6638 DO j=jstrr,jendr
6639 DO i=istr,iendr
6640 uout(i,j)=0.5_r8*(urot(i-1,j)+urot(i,j))
6641# ifdef MASKING
6642 uout(i,j)=uout(i,j)*grid(ng)%umask(i,j)
6643# endif
6644# ifdef WET_DRY
6645 uout(i,j)=uout(i,j)*grid(ng)%umask_wet(i,j)
6646# endif
6647 END DO
6648 END DO
6649 DO j=jstr,jendr
6650 DO i=istrr,iendr
6651 vout(i,j)=0.5_r8*(vrot(i,j-1)+vrot(i,j))
6652# ifdef MASKING
6653 vout(i,j)=vout(i,j)*grid(ng)%vmask(i,j)
6654# endif
6655# ifdef WET_DRY
6656 vout(i,j)=vout(i,j)*grid(ng)%vmask_wet(i,j)
6657# endif
6658 END DO
6659 END DO
6660
6661 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
6662 CALL exchange_u2d_tile (ng, tile, &
6663 & lbi, ubi, lbj, ubj, &
6664 & uout)
6665 CALL exchange_v2d_tile (ng, tile, &
6666 & lbi, ubi, lbj, ubj, &
6667 & vout)
6668 END IF
6669 END IF
6670!
6671!-----------------------------------------------------------------------
6672! Rotate from computational grid to geographical (EAST, NORTH)
6673! directions (ROMS Export case: vector at RHO-points).
6674!-----------------------------------------------------------------------
6675!
6676 ELSE IF (lrotate.eq.grid2geo_rho) THEN
6677 uout=0.0_r8
6678 vout=0.0_r8
6679 DO j=jstr,jend
6680 DO i=istr,iend
6681 urho=0.5_r8*(uinp(i,j)+uinp(i+1,j))
6682 vrho=0.5_r8*(vinp(i,j)+vinp(i,j+1))
6683 uout(i,j)=urho*grid(ng)%CosAngler(i,j)- &
6684 & vrho*grid(ng)%SinAngler(i,j)
6685 vout(i,j)=vrho*grid(ng)%CosAngler(i,j)+ &
6686 & urho*grid(ng)%SinAngler(i,j)
6687# ifdef MASKING
6688 uout(i,j)=uout(i,j)*grid(ng)%rmask(i,j)
6689 vout(i,j)=vout(i,j)*grid(ng)%rmask(i,j)
6690# endif
6691# ifdef WET_DRY
6692 uout(i,j)=uout(i,j)*grid(ng)%rmask_wet(i,j)
6693 vout(i,j)=vout(i,j)*grid(ng)%rmask_wet(i,j)
6694# endif
6695 END DO
6696 END DO
6697!
6698 CALL bc_r2d_tile (ng, tile, &
6699 & lbi, ubi, lbj, ubj, &
6700 & uout)
6701 CALL bc_r2d_tile (ng, tile, &
6702 & lbi, ubi, lbj, ubj, &
6703 & vout)
6704!
6705 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
6706 CALL exchange_r2d_tile (ng, tile, &
6707 & lbi, ubi, lbj, ubj, &
6708 & uout)
6709 CALL exchange_r2d_tile (ng, tile, &
6710 & lbi, ubi, lbj, ubj, &
6711 & vout)
6712 END IF
6713 END IF
6714# else
6715!
6716!-----------------------------------------------------------------------
6717! Otherwise, load unrotated components to staggered location. ROMS grid
6718! is not curvilinear (ROMS import case). It is very unlikely to have
6719! realistic applications that are not curvilinear and rotated).
6720!-----------------------------------------------------------------------
6721!
6722 IF (lrotate.eq.geo2grid_rho) THEN ! RHO-points
6723 DO j=jstrr,jendr
6724 DO i=istrr,iendr
6725 uout(i,j)=uinp(i,j)
6726 vout(i,j)=vinp(i,j)
6727 END DO
6728 END DO
6729!
6730 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
6731 CALL exchange_r2d_tile (ng, tile, &
6732 & lbi, ubi, lbj, ubj, &
6733 & uout)
6734 CALL exchange_r2d_tile (ng, tile, &
6735 & lbi, ubi, lbj, ubj, &
6736 & vout)
6737 END IF
6738
6739 ELSE IF (lrotate.eq.geo2grid) THEN ! U- and V-points
6740 DO j=jstrr,jendr
6741 DO i=istr,iendr
6742 uout(i,j)=0.5_r8*(uinp(i-1,j)+uinp(i,j))
6743# ifdef MASKING
6744 uout(i,j)=uout(i,j)*grid(ng)%umask(i,j)
6745# endif
6746# ifdef WET_DRY
6747 uout(i,j)=uout(i,j)*grid(ng)%umask_wet(i,j)
6748# endif
6749 END DO
6750 END DO
6751 DO j=jstr,jendr
6752 DO i=istrr,iendr
6753 vout(i,j)=0.5_r8*(vinp(i,j-1)+vinp(i,j))
6754# ifdef MASKING
6755 vout(i,j)=vout(i,j)*grid(ng)%vmask(i,j)
6756# endif
6757# ifdef WET_DRY
6758 vout(i,j)=vout(i,j)*grid(ng)%vmask_wet(i,j)
6759# endif
6760 END DO
6761 END DO
6762!
6763 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
6764 CALL exchange_u2d_tile (ng, tile, &
6765 & lbi, ubi, lbj, ubj, &
6766 & uout)
6767 CALL exchange_v2d_tile (ng, tile, &
6768 & lbi, ubi, lbj, ubj, &
6769 & vout)
6770 END IF
6771 END IF
6772# endif
6773!
6774!-----------------------------------------------------------------------
6775! Distributed-memory tile (halo) exchange.
6776!-----------------------------------------------------------------------
6777!
6778 CALL mp_exchange2d (ng, tile, inlm, 2, &
6779 & lbi, ubi, lbj, ubj, &
6780 & nghostpoints, &
6781 & ewperiodic(ng), nsperiodic(ng), &
6782 & uout, vout)
6783!
6784 IF (esm_track) THEN
6785 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Rotate', &
6786 & ', PET', petrank
6787 FLUSH (trac)
6788 END IF
6789!

References bc_2d_mod::bc_r2d_tile(), mod_param::bounds, 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, petrank, and 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 cmeps_roms_mod::roms_setclock ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 2405 of file cmeps_roms.h.

2406!
2407!=======================================================================
2408! !
2409! Sets ROMS component date calendar, start and stop time, and !
2410! coupling interval. At initilization, the variable "tdays" is !
2411! the initial time meassured in fractional days since the reference !
2412! time. !
2413! !
2414!=======================================================================
2415!
2416! Imported variable declarations.
2417!
2418 integer, intent(out) :: rc
2419!
2420 TYPE (ESMF_GridComp) :: model
2421!
2422! Local variable declarations.
2423!
2424 integer :: ng
2425 integer :: ref_year, start_year, stop_year
2426 integer :: ref_month, start_month, stop_month
2427 integer :: ref_day, start_day, stop_day
2428 integer :: ref_hour, start_hour, stop_hour
2429 integer :: ref_minute, start_minute, stop_minute
2430 integer :: ref_second, start_second, stop_second
2431 integer :: PETcount, localPET
2432 integer :: TimeFrac
2433!
2434 real(dp) :: MyStartTime, MyStopTime
2435!
2436 character (len= 22) :: Calendar
2437 character (len= 22) :: StartTimeString, StopTimeString
2438 character (len=160) :: message
2439
2440 character (len=*), parameter :: MyFile = &
2441 & __FILE__//", ROMS_SetClock"
2442!
2443 TYPE (ESMF_CalKind_Flag) :: CalType
2444 TYPE (ESMF_Clock) :: clock
2445 TYPE (ESMF_VM) :: vm
2446!
2447!-----------------------------------------------------------------------
2448! Initialize return code flag to success state (no error).
2449!-----------------------------------------------------------------------
2450!
2451 IF (esm_track) THEN
2452 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetClock', &
2453 & ', PET', petrank
2454 FLUSH (trac)
2455 END IF
2456 rc=esmf_success
2457!
2458!-----------------------------------------------------------------------
2459! Querry the Virtual Machine (VM) parallel environmemt for the MPI
2460! communicator handle and current node rank.
2461!-----------------------------------------------------------------------
2462!
2463 CALL esmf_gridcompget (model, &
2464 & localpet=localpet, &
2465 & petcount=petcount, &
2466 & vm=vm, &
2467 & rc=rc)
2468 IF (esmf_logfounderror(rctocheck=rc, &
2469 & msg=esmf_logerr_passthru, &
2470 & line=__line__, &
2471 & file=myfile)) THEN
2472 RETURN
2473 END IF
2474!
2475!-----------------------------------------------------------------------
2476! Create ROMS component clock.
2477!-----------------------------------------------------------------------
2478!
2479! Set ROMS time reference: model time is meassured as seconds since
2480! reference time. ESMF does not support the Proleptic Gregorian
2481! Calendar that extends backward the dates preceeding 15 October 1582
2482! which always have a year length of 365.2425 days.
2483!
2484! Using driver provided calendar since UFS Weather Model does not
2485! support Proleptic Gregorian Calendar.
2486!
2487 ref_year =rclock%year
2488 ref_month =rclock%month
2489 ref_day =rclock%day
2490 ref_hour =rclock%hour
2491 ref_minute=rclock%minutes
2492 ref_second=rclock%seconds
2493 calendar =trim(clockinfo(idriver)%CalendarString)
2494 clockinfo(iroms)%CalendarString = trim(calendar)
2495!
2496 IF (clockinfo(iroms)%CalendarString == '360_day') THEN
2497 caltype=esmf_calkind_360day
2498 ELSE
2499 caltype=esmf_calkind_gregorian
2500 END IF
2501!
2502 clockinfo(iroms)%Calendar=esmf_calendarcreate(caltype, &
2503 & name=trim(calendar),&
2504 & rc=rc)
2505 IF (esmf_logfounderror(rctocheck=rc, &
2506 & msg=esmf_logerr_passthru, &
2507 & line=__line__, &
2508 & file=myfile)) THEN
2509 RETURN
2510 END IF
2511!
2512! Set reference time.
2513!
2514 CALL esmf_timeset (clockinfo(iroms)%ReferenceTime, &
2515 & yy=ref_year, &
2516 & mm=ref_month, &
2517 & dd=ref_day, &
2518 & h =ref_hour, &
2519 & m =ref_minute, &
2520 & s =ref_second, &
2521 & calendar=clockinfo(iroms)%Calendar, &
2522 & rc=rc)
2523 IF (esmf_logfounderror(rctocheck=rc, &
2524 & msg=esmf_logerr_passthru, &
2525 & line=__line__, &
2526 & file=myfile)) THEN
2527 RETURN
2528 END IF
2529
2530# ifdef REGRESS_STARTCLOCK
2531!
2532! Set start time, use the minimum value of all nested grids. Notice
2533! that a coupling interval is substracted since the driver clock was
2534! regressed by that amount to properly initialize all ESM components.
2535!
2536 mystarttime=minval(tdays)-clockinfo(iroms)%Time_Step/86400.0_dp
2537# else
2538!
2539! Set start time, use the minimum value of all nested grids.
2540!
2541 mystarttime=minval(tdays)
2542# endif
2543!
2544 clockinfo(iroms)%Time_Start=mystarttime*86400.0_dp
2545 CALL caldate (mystarttime, &
2546 & yy_i=start_year, &
2547 & mm_i=start_month, &
2548 & dd_i=start_day, &
2549 & h_i =start_hour, &
2550 & m_i =start_minute, &
2551 & s_i =start_second)
2552 CALL time_string (clockinfo(iroms)%Time_Start, &
2553 & clockinfo(iroms)%Time_StartString)
2554!
2555 CALL esmf_timeset (clockinfo(iroms)%StartTime, &
2556 & yy=start_year, &
2557 & mm=start_month, &
2558 & dd=start_day, &
2559 & h =start_hour, &
2560 & m =start_minute, &
2561 & s =start_second, &
2562 & ms=0, &
2563 & calendar=clockinfo(iroms)%Calendar, &
2564 & rc=rc)
2565 IF (esmf_logfounderror(rctocheck=rc, &
2566 & msg=esmf_logerr_passthru, &
2567 & line=__line__, &
2568 & file=myfile)) THEN
2569 RETURN
2570 END IF
2571!
2572! Set stop time, use the maximum value of all nested grids.
2573!
2574 mystoptime=0.0_dp
2575 DO ng=1,models(iroms)%Ngrids
2576 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2577 mystoptime=max(mystoptime, &
2578 & tdays(ng)+(real(ntimes(ng),dp)*dt(ng))*sec2day)
2579 END IF
2580 END DO
2581 clockinfo(iroms)%Time_Stop=mystoptime*86400.0_dp
2582 CALL caldate (mystoptime, &
2583 & yy_i=stop_year, &
2584 & mm_i=stop_month, &
2585 & dd_i=stop_day, &
2586 & h_i =stop_hour, &
2587 & m_i =stop_minute, &
2588 & s_i =stop_second)
2589 CALL time_string (clockinfo(iroms)%Time_Stop, &
2590 & clockinfo(iroms)%Time_StopString)
2591!
2592 CALL esmf_timeset (clockinfo(iroms)%StopTime, &
2593 & yy=stop_year, &
2594 & mm=stop_month, &
2595 & dd=stop_day, &
2596 & h =stop_hour, &
2597 & m =stop_minute, &
2598 & s =stop_second, &
2599 & calendar=clockinfo(iroms)%Calendar, &
2600 & rc=rc)
2601 IF (esmf_logfounderror(rctocheck=rc, &
2602 & msg=esmf_logerr_passthru, &
2603 & line=__line__, &
2604 & file=myfile)) THEN
2605 RETURN
2606 END IF
2607!
2608!-----------------------------------------------------------------------
2609! Modify component clock time step.
2610!-----------------------------------------------------------------------
2611!
2612 timefrac=0
2613 DO ng=1,models(iroms)%Ngrids
2614 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2615 timefrac=max(timefrac, &
2616 & maxval(models(iroms)%TimeFrac(ng,:), &
2617 & mask=models(:)%IsActive))
2618 END IF
2619 END DO
2620 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
2621 rc=esmf_rc_not_set ! cannot be 0
2622 IF (esmf_logfounderror(rctocheck=rc, &
2623 & msg=esmf_logerr_passthru, &
2624 & line=__line__, &
2625 & file=myfile)) THEN
2626 RETURN
2627 END IF
2628 END IF
2629!
2630 clockinfo(iroms)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
2631!
2632!-----------------------------------------------------------------------
2633! Create ROMS component clock.
2634!-----------------------------------------------------------------------
2635!
2636 clockinfo(iroms)%Name='ROMS_clock'
2637 clock=esmf_clockcreate(clockinfo(iroms)%TimeStep, &
2638 & clockinfo(iroms)%StartTime, &
2639 & stoptime =clockinfo(iroms)%StopTime, &
2640 & reftime =clockinfo(iroms)%ReferenceTime, &
2641 & name =trim(clockinfo(iroms)%Name), &
2642 & rc=rc)
2643 IF (esmf_logfounderror(rctocheck=rc, &
2644 & msg=esmf_logerr_passthru, &
2645 & line=__line__, &
2646 & file=myfile)) THEN
2647 RETURN
2648 END IF
2649 clockinfo(iroms)%Clock=clock
2650!
2651! Set ROMS component clock.
2652!
2653 CALL esmf_gridcompset (model, &
2654 & clock=clockinfo(iroms)%Clock, &
2655 & rc=rc)
2656 IF (esmf_logfounderror(rctocheck=rc, &
2657 & msg=esmf_logerr_passthru, &
2658 & line=__line__, &
2659 & file=myfile)) THEN
2660 RETURN
2661 END IF
2662!
2663! Get current time.
2664!
2665 CALL esmf_clockget (clockinfo(iroms)%Clock, &
2666 & currtime=clockinfo(iroms)%CurrentTime, &
2667 & rc=rc)
2668 IF (esmf_logfounderror(rctocheck=rc, &
2669 & msg=esmf_logerr_passthru, &
2670 & line=__line__, &
2671 & file=myfile)) THEN
2672 RETURN
2673 END IF
2674!
2675!-----------------------------------------------------------------------
2676! Compare driver time against ROMS component time.
2677!-----------------------------------------------------------------------
2678!
2679 IF (clockinfo(idriver)%Restarted) THEN
2680 starttimestring=trim(clockinfo(idriver)%Time_RestartString)
2681 ELSE
2682 starttimestring=trim(clockinfo(idriver)%Time_StartString)
2683 END IF
2684!
2685! Report start and stop time clocks.
2686!
2687 IF (localpet.eq.0) THEN
2688 WRITE (cplout,'(/)')
2689 WRITE (cplout,10) 'DRIVER Calendar: ', &
2690 & trim(clockinfo(idriver)%CalendarString), &
2691 & 'DRIVER Start Clock: ', &
2692 & trim(clockinfo(idriver)%Time_StartString), &
2693 & 'DRIVER Stop Clock: ', &
2694 & trim(clockinfo(idriver)%Time_StopString)
2695!
2696 WRITE (cplout,10) 'ROMS Calendar: ', &
2697 & trim(clockinfo(iroms)%CalendarString), &
2698 & 'ROMS Start Clock: ', &
2699 & trim(clockinfo(iroms)%Time_StartString), &
2700 & 'ROMS Stop Clock: ', &
2701 & trim(clockinfo(iroms)%Time_StopString)
2702 END IF
2703!
2704! Compare Driver and ROMS clocks.
2705!
2706 IF (clockinfo(iroms)%Time_StartString(1:19).ne. &
2707 & starttimestring(1:19)) THEN
2708 IF (localpet.eq.0) THEN
2709 WRITE (cplout,20) 'ROMS Start Time: ', &
2710 & clockinfo(iroms)%Time_StartString(1:19), &
2711 & 'Driver Start Time: ', &
2712 & trim(starttimestring), &
2713 & ' are not equal!'
2714 END IF
2715 message='Driver and ROMS start times do not match: '// &
2716 & 'please check the config files.'
2717 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
2718 & msg=trim(message))
2719 RETURN
2720 END IF
2721!
2722 IF (clockinfo(iroms )%Time_StopString(1:19).ne. &
2723 & clockinfo(idriver)%Time_StopString(1:19)) THEN
2724 IF (localpet.eq.0) THEN
2725 WRITE (cplout,20) 'ROMS Stop Time: ', &
2726 & clockinfo(iroms )%Time_StopString(1:19), &
2727 & 'Driver Stop Time: ', &
2728 & trim(clockinfo(idriver)%Time_StopString), &
2729 & ' are not equal!'
2730 END IF
2731 message='Driver and ROMS stop times do not match: '// &
2732 & 'please check the config files.'
2733 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
2734 & msg=trim(message))
2735 RETURN
2736 END IF
2737!
2738 IF (trim(clockinfo(iroms )%CalendarString).ne. &
2739 & trim(clockinfo(idriver)%CalendarString)) THEN
2740 IF (localpet.eq.0) THEN
2741 WRITE (cplout,20) 'ROMS Calendar: ', &
2742 & trim(clockinfo(iroms )%CalendarString), &
2743 & 'Driver Calendar: ', &
2744 & trim(clockinfo(idriver)%CalendarString), &
2745 & ' are not equal!'
2746 END IF
2747 message='Driver and ROMS calendars do not match: '// &
2748 & 'please check the config files.'
2749 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
2750 & msg=trim(message))
2751 RETURN
2752 END IF
2753!
2754 IF (esm_track) THEN
2755 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetClock', &
2756 & ', PET', petrank
2757 FLUSH (trac)
2758 END IF
2759!
2760 10 FORMAT (2x,a,2x,a/,2x,a,2x,a,/,2x,a,2x,a,/)
2761 20 FORMAT (/,2x,a,a,/,2x,a,a,/,2x,a)
2762!
2763 RETURN

References dateclock_mod::caldate(), clockinfo, coupled, cplout, mod_kinds::dp, mod_scalars::dt, esm_track, idriver, iroms, mod_param::mm, models, mod_scalars::ntimes, petrank, mod_scalars::rclock, mod_scalars::sec2day, mod_scalars::tdays, dateclock_mod::time_string(), and 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 cmeps_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 4294 of file cmeps_roms.h.

4297!
4298!=======================================================================
4299! !
4300! Finalize ROMS component execution. It calls ROMS_finalize. !
4301! !
4302!=======================================================================
4303!
4304! Imported variable declarations.
4305!
4306 integer, intent(out) :: rc
4307!
4308 TYPE (ESMF_Clock) :: clock
4309 TYPE (ESMF_GridComp) :: model
4310 TYPE (ESMF_State) :: ExportState
4311 TYPE (ESMF_State) :: ImportState
4312!
4313! Local variable declarations.
4314!
4315 character (len=*), parameter :: MyFile = &
4316 & __FILE__//", ROMS_SetFinalize"
4317!
4318!-----------------------------------------------------------------------
4319! Initialize return code flag to success state (no error).
4320!-----------------------------------------------------------------------
4321!
4322 IF (esm_track) THEN
4323 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetFinalize', &
4324 & ', PET', petrank
4325 FLUSH (trac)
4326 END IF
4327 rc=esmf_success
4328!
4329!-----------------------------------------------------------------------
4330! If ng=1, finalize ROMS component. In nesting applications this step
4331! needs to be done only once.
4332!-----------------------------------------------------------------------
4333!
4334 CALL roms_finalize
4335 FLUSH (cplout) ! flush coupling output buffer
4336 CLOSE (cplout) ! close coupling log file
4337!
4338 IF (esm_track) THEN
4339 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetFinalize', &
4340 & ', PET', petrank
4341 FLUSH (trac)
4342 END IF
4343!
4344 RETURN

References cplout, esm_track, petrank, roms_kernel_mod::roms_finalize(), and 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 cmeps_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 3101 of file cmeps_roms.h.

3102!
3103!=======================================================================
3104! !
3105! Sets ROMS component staggered, horizontal grids arrays and !
3106! land/sea mask, if any. !
3107! !
3108!=======================================================================
3109!
3110! Imported variable declarations.
3111!
3112 integer, intent(in) :: ng, tile
3113 integer, intent(out) :: rc
3114!
3115 TYPE (ESMF_GridComp), intent(inout) :: model
3116!
3117! Local variable declarations.
3118!
3119 integer :: MyTile, gtype, i, ivar, j, node
3120 integer :: Istr, Iend, Jstr, Jend
3121 integer :: IstrR, IendR, JstrR, JendR
3122 integer :: localDE, localDEcount
3123 integer :: staggerEdgeLWidth(2)
3124 integer :: staggerEdgeUWidth(2)
3125!
3126 integer, allocatable :: deBlockList(:,:,:)
3127 integer (i4b), pointer :: ptrM(:,:) => null() ! land/sea mask
3128!
3129 real (dp), pointer :: ptrA(:,:) => null() ! area
3130 real (dp), pointer :: ptrX(:,:) => null() ! longitude
3131 real (dp), pointer :: ptrY(:,:) => null() ! latitude
3132!
3133 character (len=*), parameter :: MyFile = &
3134 & __FILE__//", ROMS_SetGridArrays"
3135!
3136 TYPE (ESMF_DistGrid) :: distGrid
3137 TYPE (ESMF_StaggerLoc) :: staggerLoc
3138!
3139!-----------------------------------------------------------------------
3140! Initialize return code flag to success state (no error).
3141!-----------------------------------------------------------------------
3142!
3143 IF (esm_track) THEN
3144 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetGridArrays', &
3145 & ', PET', petrank
3146 FLUSH (trac)
3147 END IF
3148 rc=esmf_success
3149!
3150!-----------------------------------------------------------------------
3151! Set limits of the grid arrays based on tile decomposition (MPI rank)
3152! and nested grid number.
3153!-----------------------------------------------------------------------
3154!
3155 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
3156 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
3157 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
3158 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
3159!
3160 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
3161 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
3162 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
3163 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
3164!
3165! Set tiles lower and upper bounds for each decomposition element.
3166! In ROMS, the "exclusive region" for each decomposition element or
3167! horizontal tile ranges is bounded by (Istr:Iend, Jstr:Jend). Each
3168! tiled array is dimensioned as (LBi:UBi, LBj:UBj) which includes
3169! halo regions (usually 2 ghost points) and padding when appropriate
3170! (total/memory region). All ROMS arrays are horizontally dimensioned
3171! with the same bounds regardless if they are variables located at
3172! RHO-, PSI-, U-, or V-points. There is no halos at the boundary edges.
3173! The physical boundary is a U-points (east/west edges) and V-points
3174! (south/north edges). The boundary for RHO-points variables are
3175! located at half grid (dx,dy) distance away from the physical boundary
3176! at array indices(i=0; i=Lm+1) and (j=0; j=Mm+1).
3177!
3178! --------------------- UBj ESMF uses a very
3179! | | complicated array
3180! | Jend __________ | regions:
3181! | | | |
3182! | | | | * interior region
3183! | | | | * exclusive region
3184! | Jstr|__________| | * computational region
3185! | Istr Iend | * total (memory) region
3186! | |
3187! --------------------- LBj
3188! LBi UBi
3189!
3190 IF (.not.allocated(deblocklist)) THEN
3191 allocate ( deblocklist(2,2,ntilei(ng)*ntilej(ng)) )
3192 END IF
3193 DO mytile=0,ntilei(ng)*ntilej(ng)-1
3194 deblocklist(1,1,mytile+1)=bounds(ng)%Istr(mytile)
3195 deblocklist(1,2,mytile+1)=bounds(ng)%Iend(mytile)
3196 deblocklist(2,1,mytile+1)=bounds(ng)%Jstr(mytile)
3197 deblocklist(2,2,mytile+1)=bounds(ng)%Jend(mytile)
3198 END DO
3199!
3200!-----------------------------------------------------------------------
3201! Create ESMF DistGrid object based on model domain decomposition.
3202!-----------------------------------------------------------------------
3203!
3204! A single Decomposition Element (DE) per Persistent Execution Thread
3205! (PET).
3206!
3207 distgrid=esmf_distgridcreate(minindex=(/ 1, 1 /), &
3208 & maxindex=(/ lm(ng), mm(ng) /), &
3209 & deblocklist=deblocklist, &
3210 & rc=rc)
3211 IF (esmf_logfounderror(rctocheck=rc, &
3212 & msg=esmf_logerr_passthru, &
3213 & line=__line__, &
3214 & file=myfile)) THEN
3215 RETURN
3216 END IF
3217!
3218! Report ROMS DistGrid based on model domain decomposition.
3219!
3220 IF ((tile.eq.0).and.(debuglevel.gt.0)) THEN
3221 WRITE (cplout,10) ng, trim(gridtype(icenter))//" Point", &
3222 & ntilei(ng), ntilej(ng)
3223 DO mytile=1,ntilei(ng)*ntilej(ng)
3224 WRITE (cplout,20) mytile-1, deblocklist(1,1,mytile), &
3225 & deblocklist(1,2,mytile), &
3226 & deblocklist(2,1,mytile), &
3227 & deblocklist(2,2,mytile)
3228 END DO
3229 END IF
3230 IF (allocated(deblocklist)) deallocate (deblocklist)
3231!
3232!-----------------------------------------------------------------------
3233! Set component grid coordinates.
3234!-----------------------------------------------------------------------
3235!
3236! Define component grid location type: Arakawa C-grid.
3237!
3238! Icenter: RHO-point, cell center
3239! Icorner: PSI-point, cell corners
3240! Iupoint: U-point, cell west/east sides
3241! Ivpoint: V-point, cell south/north sides
3242!
3243 IF (.not.allocated(models(iroms)%mesh)) THEN
3244 allocate ( models(iroms)%mesh(4) )
3245 models(iroms)%mesh(1)%gtype=icenter
3246 models(iroms)%mesh(2)%gtype=icorner
3247 models(iroms)%mesh(3)%gtype=iupoint
3248 models(iroms)%mesh(4)%gtype=ivpoint
3249 END IF
3250!
3251! Create ESMF Grid. The array indices are global following ROMS
3252! design.
3253!
3254 models(iroms)%grid(ng)=esmf_gridcreate(distgrid=distgrid, &
3255 & gridedgelwidth=(/2,2/), &
3256 & gridedgeuwidth=(/2,2/), &
3257 & indexflag=esmf_index_global, &
3258 & name=trim(models(iroms)%name), &
3259 & rc=rc)
3260 IF (esmf_logfounderror(rctocheck=rc, &
3261 & msg=esmf_logerr_passthru, &
3262 & line=__line__, &
3263 & file=myfile)) THEN
3264 RETURN
3265 END IF
3266!
3267! Get number of local decomposition elements (DEs). Usually, a single
3268! DE is associated with each Persistent Execution Thread (PETs). Thus,
3269! localDEcount=1.
3270!
3271 CALL esmf_gridget (models(iroms)%grid(ng), &
3272 & localdecount=localdecount, &
3273 & rc=rc)
3274 IF (esmf_logfounderror(rctocheck=rc, &
3275 & msg=esmf_logerr_passthru, &
3276 & line=__line__, &
3277 & file=myfile)) THEN
3278 RETURN
3279 END IF
3280!
3281! Mesh coordinates for each variable type.
3282!
3283 mesh_loop : DO ivar=1,ubound(models(iroms)%mesh, dim=1)
3284!
3285! Set staggering type, Arakawa C-grid.
3286!
3287 SELECT CASE (models(iroms)%mesh(ivar)%gtype)
3288 CASE (icenter)
3289 staggerloc=esmf_staggerloc_center
3290 staggeredgelwidth=(/1,1/)
3291 staggeredgeuwidth=(/1,1/)
3292 CASE (icorner)
3293 staggerloc=esmf_staggerloc_corner
3294 staggeredgelwidth=(/1,1/)
3295 staggeredgeuwidth=(/2,2/)
3296 CASE (iupoint)
3297 staggerloc=esmf_staggerloc_edge1
3298 staggeredgelwidth=(/1,1/)
3299 staggeredgeuwidth=(/2,1/)
3300 CASE (ivpoint)
3301 staggerloc=esmf_staggerloc_edge2
3302 staggeredgelwidth=(/1,1/)
3303 staggeredgeuwidth=(/1,2/)
3304 END SELECT
3305!
3306! Allocate coordinate storage associated with staggered grid type.
3307! No coordinate values are set yet.
3308!
3309 CALL esmf_gridaddcoord (models(iroms)%grid(ng), &
3310 & staggerloc=staggerloc, &
3311 & staggeredgelwidth=staggeredgelwidth, &
3312 & staggeredgeuwidth=staggeredgeuwidth, &
3313 & rc=rc)
3314 IF (esmf_logfounderror(rctocheck=rc, &
3315 & msg=esmf_logerr_passthru, &
3316 & line=__line__, &
3317 & file=myfile)) THEN
3318 RETURN
3319 END IF
3320
3321# ifdef MASKING
3322!
3323! Allocate storage for land/sea masking.
3324!
3325 CALL esmf_gridadditem (models(iroms)%grid(ng), &
3326 & staggerloc=staggerloc, &
3327 & itemflag=esmf_griditem_mask, &
3328 & rc=rc)
3329 IF (esmf_logfounderror(rctocheck=rc, &
3330 & msg=esmf_logerr_passthru, &
3331 & line=__line__, &
3332 & file=myfile)) THEN
3333 RETURN
3334 END IF
3335 models(iroms)%LandValue=0
3336 models(iroms)%SeaValue=1
3337# endif
3338!
3339! Allocate storage for grid area.
3340!
3341 CALL esmf_gridadditem (models(iroms)%grid(ng), &
3342 & staggerloc=staggerloc, &
3343 & itemflag=esmf_griditem_area, &
3344 & rc=rc)
3345 IF (esmf_logfounderror(rctocheck=rc, &
3346 & msg=esmf_logerr_passthru, &
3347 & line=__line__, &
3348 & file=myfile)) THEN
3349 RETURN
3350 END IF
3351!
3352! Get pointers and set coordinates for the grid. Usually, the DO-loop
3353! is executed once since localDEcount=1.
3354!
3355 de_loop : DO localde=0,localdecount-1
3356 CALL esmf_gridgetcoord (models(iroms)%grid(ng), &
3357 & coorddim=1, &
3358 & localde=localde, &
3359 & staggerloc=staggerloc, &
3360 & farrayptr=ptrx, &
3361 & rc=rc)
3362 IF (esmf_logfounderror(rctocheck=rc, &
3363 & msg=esmf_logerr_passthru, &
3364 & line=__line__, &
3365 & file=myfile)) THEN
3366 RETURN
3367 END IF
3368!
3369 CALL esmf_gridgetcoord (models(iroms)%grid(ng), &
3370 & coorddim=2, &
3371 & localde=localde, &
3372 & staggerloc=staggerloc, &
3373 & farrayptr=ptry, &
3374 & rc=rc)
3375 IF (esmf_logfounderror(rctocheck=rc, &
3376 & msg=esmf_logerr_passthru, &
3377 & line=__line__, &
3378 & file=myfile)) THEN
3379 RETURN
3380 END IF
3381!
3382 CALL esmf_gridgetitem (models(iroms)%grid(ng), &
3383 & localde=localde, &
3384 & staggerloc=staggerloc, &
3385 & itemflag=esmf_griditem_mask, &
3386 & farrayptr=ptrm, &
3387 & rc=rc)
3388 IF (esmf_logfounderror(rctocheck=rc, &
3389 & msg=esmf_logerr_passthru, &
3390 & line=__line__, &
3391 & file=myfile)) THEN
3392 RETURN
3393 END IF
3394!
3395 CALL esmf_gridgetitem (models(iroms)%grid(ng), &
3396 & localde=localde, &
3397 & staggerloc=staggerloc, &
3398 & itemflag=esmf_griditem_area, &
3399 & farrayptr=ptra, &
3400 & rc=rc)
3401 IF (esmf_logfounderror(rctocheck=rc, &
3402 & msg=esmf_logerr_passthru, &
3403 & line=__line__, &
3404 & file=myfile)) THEN
3405 RETURN
3406 END IF
3407!
3408! Fill grid pointers.
3409!
3410 SELECT CASE (models(iroms)%mesh(ivar)%gtype)
3411! U-points
3412 CASE (icenter)
3413 DO j=jstrr,jendr
3414 DO i=istrr,iendr
3415 ptrx(i,j)=grid(ng)%lonr(i,j)
3416 ptry(i,j)=grid(ng)%latr(i,j)
3417# ifdef MASKING
3418 ptrm(i,j)=int(grid(ng)%rmask(i,j))
3419# else
3420 ptrm(i,j)=1
3421# endif
3422 ptra(i,j)=grid(ng)%om_r(i,j)*grid(ng)%on_r(i,j)
3423 END DO
3424 END DO
3425! PSI-points
3426 CASE (icorner)
3427 DO j=jstrr,jendr
3428 DO i=istrr,iendr
3429 ptrx(i,j)=grid(ng)%lonp(i,j)
3430 ptry(i,j)=grid(ng)%latp(i,j)
3431# ifdef MASKING
3432 ptrm(i,j)=int(grid(ng)%pmask(i,j))
3433# else
3434 ptrm(i,j)=1
3435# endif
3436 ptra(i,j)=grid(ng)%om_p(i,j)*grid(ng)%on_p(i,j)
3437 END DO
3438 END DO
3439! Extrapolate PSI-points at bottom edge
3440!
3441 IF (tile.lt.ntilei(ng)) THEN
3442 ptrx(:,jstr-1)=2.0_dp*ptrx(:,jstr)-ptrx(:,jstr+1)
3443 ptry(:,jstr-1)=2.0_dp*ptry(:,jstr)-ptry(:,jstr+1)
3444 ptrm(:,jstr-1)=ptrm(:,jstr)
3445 ptra(:,jstr-1)=ptra(:,jstr)
3446 END IF
3447! Extrapolate PSI-points at left edge
3448!
3449 IF (mod(tile,ntilei(ng)).eq.0) THEN
3450 ptrx(istr-1,:)=2.0_dp*ptrx(istr,:)-ptrx(istr+1,:)
3451 ptry(istr-1,:)=2.0_dp*ptry(istr,:)-ptry(istr+1,:)
3452 ptrm(istr-1,:)=ptrm(istr,:)
3453 ptra(istr-1,:)=ptra(istr,:)
3454 END IF
3455! Extrapolate PSI-points at top edge
3456!
3457 IF (tile.ge.(ntilei(ng)*(ntilej(ng)-1))) THEN
3458 ptrx(:,jend+2)=2.0_dp*ptrx(:,jend+1)-ptrx(:,jend)
3459 ptry(:,jend+2)=2.0_dp*ptry(:,jend+1)-ptry(:,jend)
3460 ptrm(:,jend+2)=ptrm(:,jend+1)
3461 ptra(:,jend+2)=ptra(:,jend+1)
3462 END IF
3463! Extrapolate PSI-points at right edge
3464!
3465 IF (mod(tile+1,ntilei(ng)).eq.0) THEN
3466 ptrx(iend+2,:)=2.0_dp*ptrx(iend+1,:)-ptrx(iend,:)
3467 ptry(iend+2,:)=2.0_dp*ptry(iend+1,:)-ptry(iend,:)
3468 ptrm(iend+2,:)=ptrm(iend+1,:)
3469 ptra(iend+2,:)=ptra(iend+1,:)
3470 END IF
3471! U-points
3472 CASE (iupoint)
3473 DO j=jstrr,jendr
3474 DO i=istr,iendr
3475 ptrx(i,j)=grid(ng)%lonu(i,j)
3476 ptry(i,j)=grid(ng)%latu(i,j)
3477# ifdef MASKING
3478 ptrm(i,j)=int(grid(ng)%umask(i,j))
3479# else
3480 ptrm(i,j)=1
3481# endif
3482 ptra(i,j)=grid(ng)%om_u(i,j)*grid(ng)%on_u(i,j)
3483 END DO
3484 END DO
3485! Extrapolate U-points at left edge
3486!
3487 IF (mod(tile,ntilei(ng)).eq.0) THEN
3488 ptrx(istr-1,:)=2.0_dp*ptrx(istr,:)-ptrx(istr+1,:)
3489 ptry(istr-1,:)=2.0_dp*ptry(istr,:)-ptry(istr+1,:)
3490 ptrm(istr-1,:)=ptrm(istr,:)
3491 ptra(istr-1,:)=ptra(istr,:)
3492 END IF
3493! Extrapolate U-points at right edge
3494!
3495 IF (mod(tile+1,ntilei(ng)).eq.0) THEN
3496 ptrx(iend+2,:)=2.0_dp*ptrx(iend+1,:)-ptrx(iend,:)
3497 ptry(iend+2,:)=2.0_dp*ptry(iend+1,:)-ptry(iend,:)
3498 ptrm(iend+2,:)=ptrm(iend+1,:)
3499 ptra(iend+2,:)=ptra(iend+1,:)
3500 END IF
3501! V-points
3502 CASE (ivpoint)
3503 DO j=jstr,jendr
3504 DO i=istrr,iendr
3505 ptrx(i,j)=grid(ng)%lonv(i,j)
3506 ptry(i,j)=grid(ng)%latv(i,j)
3507# ifdef MASKING
3508 ptrm(i,j)=int(grid(ng)%vmask(i,j))
3509# else
3510 ptrm(i,j)=1
3511# endif
3512 ptra(i,j)=grid(ng)%om_v(i,j)*grid(ng)%on_v(i,j)
3513 END DO
3514 END DO
3515! Extrapolate V-points at bottom edge
3516!
3517 IF (tile.lt.ntilei(ng)) THEN
3518 ptrx(:,jstr-1)=2.0_dp*ptrx(:,jstr)-ptrx(:,jstr+1)
3519 ptry(:,jstr-1)=2.0_dp*ptry(:,jstr)-ptry(:,jstr+1)
3520 ptrm(:,jstr-1)=ptrm(:,jstr)
3521 ptra(:,jstr-1)=ptra(:,jstr)
3522 END IF
3523! Extrapolate V-points at top edge
3524!
3525 IF (tile.ge.(ntilei(ng)*(ntilej(ng)-1))) THEN
3526 ptrx(:,jend+2)=2.0_dp*ptrx(:,jend+1)-ptrx(:,jend)
3527 ptry(:,jend+2)=2.0_dp*ptry(:,jend+1)-ptry(:,jend)
3528 ptrm(:,jend+2)=ptrm(:,jend+1)
3529 ptra(:,jend+2)=ptra(:,jend+1)
3530 END IF
3531 END SELECT
3532!
3533! Nullify pointers.
3534!
3535 IF ( associated(ptrx) ) nullify (ptrx)
3536 IF ( associated(ptry) ) nullify (ptry)
3537 IF ( associated(ptrm) ) nullify (ptrm)
3538 IF ( associated(ptra) ) nullify (ptra)
3539 END DO de_loop
3540!
3541! Debugging: write out component grid in VTK format.
3542!
3543 IF (debuglevel.ge.4) THEN
3544 gtype=models(iroms)%mesh(ivar)%gtype
3545 CALL esmf_gridwritevtk (models(iroms)%grid(ng), &
3546 & filename="roms_"// &
3547 & trim(gridtype(gtype))// &
3548 & "_point", &
3549 & staggerloc=staggerloc, &
3550 & rc=rc)
3551 IF (esmf_logfounderror(rctocheck=rc, &
3552 & msg=esmf_logerr_passthru, &
3553 & line=__line__, &
3554 & file=myfile)) THEN
3555 RETURN
3556 END IF
3557 END IF
3558 END DO mesh_loop
3559!
3560! Assign grid to gridded component.
3561!
3562 CALL esmf_gridcompset (model, &
3563 & grid=models(iroms)%grid(ng), &
3564 & rc=rc)
3565 IF (esmf_logfounderror(rctocheck=rc, &
3566 & msg=esmf_logerr_passthru, &
3567 & line=__line__, &
3568 & file=myfile)) THEN
3569 RETURN
3570 END IF
3571!
3572 IF (esm_track) THEN
3573 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetGridArrays', &
3574 & ', PET', petrank
3575 FLUSH (trac)
3576 END IF
3577 IF (debuglevel.gt.0) FLUSH (cplout)
3578!
3579 10 FORMAT (/,'ROMS Domain Decomposition:',/,25('='),/, &
3580 /,2x,'ROMS_DistGrid - Grid = ',i2.2,',',3x,'Mesh = ',a, &
3581 & ',',3x,'Partition = ',i0,' x ',i0)
3582 20 FORMAT (18x,'node = ',i0,t32,'Istr = ',i0,t45,'Iend = ',i0, &
3583 & t58,'Jstr = ',i0,t71,'Jend = ',i0)
3584!
3585 RETURN

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

Referenced by roms_setinitializep2().

Here is the caller graph for this function:

◆ roms_setinitializep1()

subroutine, private cmeps_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 1567 of file cmeps_roms.h.

1570!
1571!=======================================================================
1572! !
1573! ROMS component Phase 1 initialization: sets import and export !
1574! fields long and short names into its respective state. !
1575! !
1576!=======================================================================
1577!
1578 USE mod_parallel, ONLY : master
1579!
1580! Imported variable declarations.
1581!
1582 integer, intent(out) :: rc
1583!
1584 TYPE (ESMF_GridComp) :: model
1585 TYPE (ESMF_State) :: ImportState
1586 TYPE (ESMF_State) :: ExportState
1587 TYPE (ESMF_Clock) :: clock
1588!
1589! Local variable declarations.
1590!
1591 logical :: MasterPET, isPresent, isSet
1592!
1593 integer :: i
1594 integer :: ng = 1
1595 integer :: MyComm, PETcount, localPET
1596!
1597 TYPE (CouplingField), allocatable :: ROMSexport(:), ROMSimport(:)
1598 TYPE (ESMF_VM) :: vm
1599 TYPE (yaml_tree) :: YML
1600!
1601# ifdef ADD_NESTED_STATE
1602 character (len=100) :: CoupledSet, StateLabel
1603# endif
1604 character (len=240) :: StandardName, ShortName
1605 character (len=240) :: cfgValue
1606 character (len=160) :: message
1607!
1608 character (len=*), parameter :: MyFile = &
1609 & __FILE__//", ROMS_SetInitializeP1"
1610!
1611!-----------------------------------------------------------------------
1612! Initialize return code flag to success state (no error).
1613!-----------------------------------------------------------------------
1614!
1615 IF (esm_track) THEN
1616 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetInitializeP1', &
1617 & ', PET', petrank
1618 FLUSH (trac)
1619 END IF
1620 rc=esmf_success
1621!
1622!-----------------------------------------------------------------------
1623! Querry the Virtual Machine (VM) parallel environmemt for the MPI
1624! current node rank.
1625!-----------------------------------------------------------------------
1626!
1627 CALL esmf_gridcompget (model, &
1628 & vm=vm, &
1629 & rc=rc)
1630 IF (esmf_logfounderror(rctocheck=rc, &
1631 & msg=esmf_logerr_passthru, &
1632 & line=__line__, &
1633 & file=myfile)) THEN
1634 RETURN
1635 END IF
1636!
1637 CALL esmf_vmget (vm, &
1638 & localpet=localpet, &
1639 & petcount=petcount, &
1640 & mpicommunicator=mycomm, &
1641 & rc=rc)
1642 IF (esmf_logfounderror(rctocheck=rc, &
1643 & msg=esmf_logerr_passthru, &
1644 & line=__line__, &
1645 & file=myfile)) THEN
1646 RETURN
1647 END IF
1648 masterpet=localpet.eq.0
1649 petrank=localpet
1650!
1651!-----------------------------------------------------------------------
1652! Set ROMS standard ouput unit and file
1653!-----------------------------------------------------------------------
1654!
1655! Sets the ROMS standard output unit to write verbose execution info.
1656! Notice that the default standard out unit in Fortran is 6.
1657!
1658! In some applications like coupling or disjointed mpi-communications,
1659! it is advantageous to write standard output to a specific filename
1660! instead of the default Fortran standard output unit 6. If that is
1661! the case, it opens such formatted file for writing.
1662!
1663 IF (set_stdoutunit) THEN
1664 master=masterpet
1665 stdout=stdout_unit(masterpet)
1666 set_stdoutunit=.false.
1667 END IF
1668!
1669!-----------------------------------------------------------------------
1670! Open standard output unit for ROMS cap information and messages.
1671!-----------------------------------------------------------------------
1672!
1673 OPEN (cplout, file=trim(couplerlog), form='formatted', &
1674 & status='replace')
1675!
1676!-----------------------------------------------------------------------
1677! Query driver for attributes
1678!-----------------------------------------------------------------------
1679!
1680! Get ROMS coupling configuration YAML filename.
1681!
1682 CALL nuopc_compattributeget (model, &
1683 & name='CouplingConfig', &
1684 & value=cfgvalue, &
1685 & ispresent=ispresent, &
1686 & isset=isset, &
1687 & rc=rc)
1688 IF (esmf_logfounderror(rctocheck=rc, &
1689 & msg=esmf_logerr_passthru, &
1690 & line=__line__, &
1691 & file=myfile)) THEN
1692 RETURN
1693 END IF
1694!
1695 IF (ispresent.and.isset) THEN
1696 cplname= trim(cfgvalue)
1697 message='CouplingConfig = '//trim(cplname)
1698 CALL esmf_logwrite (trim(message), esmf_logmsg_info)
1699 ELSE
1700 message='CouplingConfig needs to be provided: '// &
1701 & 'please check the top level ESMF config file.'
1702 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1703 & msg=trim(message))
1704 RETURN
1705 END IF
1706!
1707! Get 'scalar_field' parameters used by cmeps to check exchanged
1708! fields.
1709!
1710 CALL nuopc_compattributeget (model, &
1711 & name='ScalarFieldName', &
1712 & value=cfgvalue, &
1713 & ispresent=ispresent, &
1714 & isset=isset, &
1715 & rc=rc)
1716 IF (esmf_logfounderror(rctocheck=rc, &
1717 & msg=esmf_logerr_passthru, &
1718 & line=__line__, &
1719 & file=myfile)) THEN
1720 RETURN
1721 END IF
1722!
1723 IF (ispresent.and.isset) THEN
1724 READ (cfgvalue,*) scalarfieldname
1725 ELSE
1726 scalarfieldname='cpl_scalars'
1727 END IF
1728 WRITE (message, '(a)') 'ScalarFieldName = '// &
1729 & trim(scalarfieldname)
1730 CALL esmf_logwrite(trim(message), esmf_logmsg_info)
1731!
1732 CALL nuopc_compattributeget(model, &
1733 & name='ScalarFieldCount', &
1734 & value=cfgvalue, &
1735 & ispresent=ispresent, &
1736 & isset=isset, &
1737 & rc=rc)
1738 IF (esmf_logfounderror(rctocheck=rc, &
1739 & msg=esmf_logerr_passthru, &
1740 & line=__line__, &
1741 & file=myfile)) THEN
1742 RETURN
1743 END IF
1744!
1745 IF (ispresent.and.isset) THEN
1746 READ (cfgvalue,*) scalarfieldcount
1747 ELSE
1748 scalarfieldcount=0
1749 END IF
1750 WRITE(message, '(a,i0)') 'ScalarFieldCount = ', &
1751 & scalarfieldcount
1752 CALL esmf_logwrite(trim(message), esmf_logmsg_info)
1753!
1754 CALL nuopc_compattributeget(model, &
1755 & name='ScalarFieldIdxGridNX', &
1756 & value=cfgvalue, &
1757 & ispresent=ispresent, &
1758 & isset=isset, &
1759 & rc=rc)
1760 IF (esmf_logfounderror(rctocheck=rc, &
1761 & msg=esmf_logerr_passthru, &
1762 & line=__line__, &
1763 & file=myfile)) THEN
1764 RETURN
1765 END IF
1766!
1767 IF (ispresent.and.isset) THEN
1768 READ(cfgvalue,*) scalarfieldidxgridnx
1769 ELSE
1770 scalarfieldidxgridnx = 0
1771 END IF
1772 WRITE(message, '(a,i0)') 'ScalarFieldIdxGridNX = ', &
1773 & scalarfieldidxgridnx
1774 CALL esmf_logwrite (trim(message), esmf_logmsg_info)
1775!
1776 CALL nuopc_compattributeget(model, &
1777 & name='ScalarFieldIdxGridNY', &
1778 & value=cfgvalue, &
1779 & ispresent=ispresent, &
1780 & isset=isset, &
1781 & rc=rc)
1782 IF (esmf_logfounderror(rctocheck=rc, &
1783 & msg=esmf_logerr_passthru, &
1784 & line=__line__, &
1785 & file=myfile)) THEN
1786 RETURN
1787 END IF
1788!
1789 IF (ispresent.and.isset) THEN
1790 READ (cfgvalue,*) scalarfieldidxgridny
1791 ELSE
1792 scalarfieldidxgridny=0
1793 END IF
1794 WRITE (message, '(a,i0)') 'ScalarFieldIdxGridNY = ', &
1795 & scalarfieldidxgridny
1796 CALL esmf_logwrite(trim(message), esmf_logmsg_info)
1797!
1798!-----------------------------------------------------------------------
1799! Create, allocate, and populate module structures. The export and
1800! import fields metadata are read from input YAML configuration file.
1801!-----------------------------------------------------------------------
1802!
1803 CALL roms_create (localpet, petcount, mycomm, rc)
1804 IF (esmf_logfounderror(rctocheck=rc, &
1805 & msg=esmf_logerr_passthru, &
1806 & line=__line__, &
1807 & file=myfile)) THEN
1808 RETURN
1809 END IF
1810!
1811!-----------------------------------------------------------------------
1812! Set ROMS Import State metadata.
1813!-----------------------------------------------------------------------
1814
1815# ifdef ADD_NESTED_STATE
1816!
1817! Add ROMS Import state. If nesting, each grid has its own import
1818! state.
1819!
1820 importing : IF (nimport(iroms).gt.0) THEN
1821 DO ng=1,models(iroms)%Ngrids
1822 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1823 coupledset=trim(coupled(iroms)%SetLabel(ng))
1824 statelabel=trim(coupled(iroms)%ImpLabel(ng))
1825 CALL nuopc_addnestedstate (importstate, &
1826 & cplset=trim(coupledset), &
1827 & nestedstatename=trim(statelabel),&
1828 & nestedstate=models(iroms)% &
1829 & importstate(ng), &
1830 rc=rc)
1831 IF (esmf_logfounderror(rctocheck=rc, &
1832 & msg=esmf_logerr_passthru, &
1833 & line=__line__, &
1834 & file=myfile)) THEN
1835 RETURN
1836 END IF
1837 IF (localpet.eq.0) THEN
1838 WRITE (cplout,10) 'ROMS adding Import Nested State: ', &
1839 & trim(statelabel), ng
1840 END IF
1841!
1842! Add fields import state.
1843!
1844 DO i=1,nimport(iroms)
1845 standardname=models(iroms)%ImportField(i)%standard_name
1846 shortname =models(iroms)%ImportField(i)%short_name
1847 IF (localpet.eq.0) THEN
1848 WRITE (cplout,20) 'Advertising Import Field: ', &
1849 & trim(shortname), trim(standardname)
1850 END IF
1851 CALL nuopc_advertise (models(iroms)%ImportState(ng), &
1852 & standardname=trim(standardname), &
1853 & name=trim(shortname), &
1854 & rc=rc)
1855 IF (esmf_logfounderror(rctocheck=rc, &
1856 & msg=esmf_logerr_passthru, &
1857 & line=__line__, &
1858 & file=myfile)) THEN
1859 RETURN
1860 END IF
1861
1862# ifdef LONGWAVE_OUT
1863!
1864 IF (trim(shortname).eq.'LWrad') THEN
1865 rc=esmf_rc_not_valid
1866 IF (localpet.eq.0) THEN
1867 WRITE (cplout,30) trim(shortname), 'LONGWAVE_OUT', &
1868 & 'downward longwave radiation: dLWrad', &
1869 & 'LONGWAVE_OUT'
1870 END IF
1871 IF (esmf_logfounderror(rctocheck=rc, &
1872 & msg=esmf_logerr_passthru, &
1873 & line=__line__, &
1874 & file=myfile)) THEN
1875 RETURN
1876 END IF
1877 END IF
1878# endif
1879 END DO
1880 END IF
1881 END DO
1882 END IF importing
1883# else
1884!
1885! Add fields to ROMS Import state. Coupled NestedStates are not
1886! supported in cdeps/cmeps.
1887!
1888 importing : IF (nimport(iroms).gt.0) THEN
1889 ng=linked_grid
1890 models(iroms)%ImportState(ng)=importstate
1891!
1892 IF (localpet.eq.0) THEN
1893 WRITE (cplout,10) 'ROMS Import STATE: ', ng
1894 END IF
1895!
1896 DO i=1,nimport(iroms)
1897 standardname=models(iroms)%ImportField(i)%standard_name
1898 shortname =models(iroms)%ImportField(i)%short_name
1899 IF (localpet.eq.0) THEN
1900 WRITE (cplout,20) 'Advertising Import Field: ', &
1901 & trim(shortname), trim(standardname)
1902 END IF
1903 CALL nuopc_advertise (models(iroms)%ImportState(ng), &
1904 & standardname=trim(standardname), &
1905 & name=trim(shortname), &
1906 & rc=rc)
1907 IF (esmf_logfounderror(rctocheck=rc, &
1908 & msg=esmf_logerr_passthru, &
1909 & line=__line__, &
1910 & file=myfile)) THEN
1911 RETURN
1912 END IF
1913
1914# ifdef LONGWAVE_OUT
1915!
1916 IF (trim(shortname).eq.'LWrad') THEN
1917 rc=esmf_rc_not_valid
1918 IF (localpet.eq.0) THEN
1919 WRITE (cplout,30) trim(shortname), 'LONGWAVE_OUT', &
1920 & 'downward longwave radiation: dLWrad', &
1921 & 'LONGWAVE_OUT'
1922 END IF
1923 IF (esmf_logfounderror(rctocheck=rc, &
1924 & msg=esmf_logerr_passthru, &
1925 & line=__line__, &
1926 & file=myfile)) THEN
1927 RETURN
1928 END IF
1929 END IF
1930# endif
1931 END DO
1932 END IF importing
1933# endif
1934!
1935!-----------------------------------------------------------------------
1936! Set ROMS Export State metadata.
1937!-----------------------------------------------------------------------
1938
1939# ifdef ADD_NESTED_STATE
1940!
1941! Add ROMS Export state. If nesting, each grid has its own export
1942! state.
1943!
1944 exporting : IF (nexport(iroms).gt.0) THEN
1945 DO ng=1,models(iroms)%Ngrids
1946 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1947 coupledset=trim(coupled(iroms)%SetLabel(ng))
1948 statelabel=trim(coupled(iroms)%ExpLabel(ng))
1949 CALL nuopc_addnestedstate (exportstate, &
1950 & cplset=trim(coupledset), &
1951 & nestedstatename=trim(statelabel),&
1952 & nestedstate=models(iroms)% &
1953 & exportstate(ng), &
1954 rc=rc)
1955 IF (esmf_logfounderror(rctocheck=rc, &
1956 & msg=esmf_logerr_passthru, &
1957 & line=__line__, &
1958 & file=myfile)) THEN
1959 RETURN
1960 END IF
1961 IF (localpet.eq.0) THEN
1962 WRITE (cplout,10) 'ROMS adding Export Nested State: ', &
1963 & trim(statelabel), ng
1964 END IF
1965!
1966! Add fields to export state.
1967!
1968 DO i=1,nexport(iroms)
1969 standardname=models(iroms)%ExportField(i)%standard_name
1970 shortname =models(iroms)%ExportField(i)%short_name
1971 IF (localpet.eq.0) THEN
1972 WRITE (cplout,20) 'Advertising Export Field: ', &
1973 & trim(shortname), trim(standardname)
1974 END IF
1975 CALL nuopc_advertise (models(iroms)%ExportState(ng), &
1976 & standardname=trim(standardname), &
1977 & name=trim(shortname), &
1978 & rc=rc)
1979 IF (esmf_logfounderror(rctocheck=rc, &
1980 & msg=esmf_logerr_passthru, &
1981 & line=__line__, &
1982 & file=myfile)) THEN
1983 RETURN
1984 END IF
1985 END DO
1986 END IF
1987 END DO
1988 END IF exporting
1989# else
1990!
1991! Add fields to ROMS Export state. Coupled NestedStates are not
1992! supported in cdeps/cmeps.
1993!
1994 exporting : IF (nexport(iroms).gt.0) THEN
1995 ng=linked_grid
1996 models(iroms)%ExportState(ng)=exportstate
1997!
1998 IF (localpet.eq.0) THEN
1999 WRITE (cplout,10) 'ROMS Export STATE: ', ng
2000 END IF
2001!
2002 DO i=1,nexport(iroms)
2003 standardname=models(iroms)%ExportField(i)%standard_name
2004 shortname =models(iroms)%ExportField(i)%short_name
2005 IF (localpet.eq.0) THEN
2006 WRITE (cplout,20) 'Advertising Export Field: ', &
2007 & trim(shortname), trim(standardname)
2008 END IF
2009 CALL nuopc_advertise (models(iroms)%ExportState(ng), &
2010 & standardname=trim(standardname), &
2011 & name=trim(shortname), &
2012 & rc=rc)
2013 IF (esmf_logfounderror(rctocheck=rc, &
2014 & msg=esmf_logerr_passthru, &
2015 & line=__line__, &
2016 & file=myfile)) THEN
2017 RETURN
2018 END IF
2019 END DO
2020 END IF exporting
2021# endif
2022!
2023 IF (esm_track) THEN
2024 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetInitializeP1', &
2025 & ', PET', petrank
2026 FLUSH (trac)
2027 END IF
2028!
2029# ifdef ADD_NESTED_STATE
2030 10 FORMAT (/,a,a,', ng = ',i0,/,31('='),/)
2031# else
2032 10 FORMAT (/,a,'ng = ',i0,/,17('='),/)
2033# endif
2034 20 FORMAT (2x,a,"'",a,"'",t45,a)
2035# ifdef LONGWAVE_OUT
2036 30 FORMAT (/,' ROMS_SetInitializeP1 - incorrect field to process: ', &
2037 & a,/,24x,'when activating option: ',a,/,24x, &
2038 & 'use instead ',a,/,24x,'or deactivate option: ',a,/)
2039# endif
2040!
2041 RETURN
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40

References coupled, coupledset, couplerlog, cplname, cplout, esm_track, iroms, linked_grid, mod_parallel::master, models, nexport, nimport, petrank, roms_create(), scalarfieldcount, scalarfieldidxgridnx, scalarfieldidxgridny, scalarfieldname, stdout_mod::set_stdoutunit, strings_mod::standardname(), mod_iounits::stdout, stdout_mod::stdout_unit(), and 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 cmeps_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 2044 of file cmeps_roms.h.

2047!
2048!=======================================================================
2049! !
2050! ROMS component Phase 2 initialization: Initializes ROMS, sets !
2051! component grid, and adds import and export fields to respective !
2052! states. !
2053! !
2054!=======================================================================
2055!
2056! Imported variable declarations.
2057!
2058 integer, intent(out) :: rc
2059!
2060 TYPE (ESMF_GridComp) :: model
2061 TYPE (ESMF_State) :: ImportState
2062 TYPE (ESMF_State) :: ExportState
2063 TYPE (ESMF_Clock) :: clock
2064!
2065! Local variable declarations.
2066!
2067 logical, save :: first
2068!
2069 integer :: LBi, UBi, LBj, UBj
2070 integer :: MyComm
2071 integer :: ng, is, localPET, PETcount, tile
2072!
2073 real (dp) :: driverDuration, romsDuration
2074!
2075 character (len=20) :: TimeStartString
2076 character (len=20) :: TimeStopString
2077
2078 character (len=*), parameter :: MyFile = &
2079 & __FILE__//", ROMS_SetInitializeP2"
2080!
2081 TYPE (ESMF_TimeInterval) :: RunDuration, TimeStep
2082 TYPE (ESMF_Time) :: CurrTime, startTime, stopTime
2083 TYPE (ESMF_CalKind_Flag) :: calkindflag
2084 TYPE (ESMF_VM) :: vm
2085!
2086!-----------------------------------------------------------------------
2087! Initialize return code flag to success state (no error).
2088!-----------------------------------------------------------------------
2089!
2090 IF (esm_track) THEN
2091 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetInitializeP2', &
2092 & ', PET', petrank
2093 FLUSH (trac)
2094 END IF
2095 rc=esmf_success
2096!
2097!-----------------------------------------------------------------------
2098! Query the Virtual Machine (VM) parallel environmemt for the MPI
2099! communicator handle and current node rank.
2100!-----------------------------------------------------------------------
2101!
2102 CALL esmf_gridcompget (model, &
2103 & vm=vm, &
2104 & rc=rc)
2105 IF (esmf_logfounderror(rctocheck=rc, &
2106 & msg=esmf_logerr_passthru, &
2107 & line=__line__, &
2108 & file=myfile)) THEN
2109 RETURN
2110 END IF
2111!
2112 CALL esmf_vmget (vm, &
2113 & localpet=localpet, &
2114 & petcount=petcount, &
2115 & mpicommunicator=mycomm, &
2116 & rc=rc)
2117 IF (esmf_logfounderror(rctocheck=rc, &
2118 & msg=esmf_logerr_passthru, &
2119 & line=__line__, &
2120 & file=myfile)) THEN
2121 RETURN
2122 END IF
2123 tile=localpet
2124!
2125!-----------------------------------------------------------------------
2126! Initialize ROMS component. In nested applications, ROMS kernel will
2127! allocate and initialize all grids with a single call to
2128! "ROMS_initialize".
2129!-----------------------------------------------------------------------
2130!
2131 first=.true.
2132 CALL roms_initialize (first, mpicomm=mycomm)
2133 IF (exit_flag.ne.noerror) THEN
2134 rc=esmf_rc_obj_init
2135 IF (esmf_logfounderror(rctocheck=rc, &
2136 & msg=esmf_logerr_passthru, &
2137 & line=__line__, &
2138 & file=myfile)) THEN
2139 RETURN
2140 END IF
2141 END IF
2142
2143# ifdef TIME_INTERP
2144!
2145!-----------------------------------------------------------------------
2146! Create field time interpolation variable attributes NetCDF file. It
2147! needs to be done after ROMS initialization since the NetCDF and
2148! mpi interface use several variables from ROMS profiling that need
2149! to be allocated.
2150!-----------------------------------------------------------------------
2151!
2152 IF (petlayoutoption.eq.'CONCURRENT') THEN
2153 CALL def_fieldatt (vm, rc)
2154 IF (esmf_logfounderror(rctocheck=rc, &
2155 & msg=esmf_logerr_passthru, &
2156 & line=__line__, &
2157 & file=myfile)) THEN
2158 RETURN
2159 END IF
2160 END IF
2161# endif
2162!
2163!-----------------------------------------------------------------------
2164! Query driver clock.
2165!-----------------------------------------------------------------------
2166!
2167 IF (models(iroms)%IsActive) THEN
2168 CALL nuopc_modelget (model, &
2169 & driverclock=clockinfo(idriver)%Clock, &
2170 rc=rc)
2171 IF (esmf_logfounderror(rctocheck=rc, &
2172 & msg=esmf_logerr_passthru, &
2173 & line=__line__, &
2174 & file=myfile)) THEN
2175 RETURN
2176 END IF
2177!
2178 CALL esmf_clockget (clockinfo(idriver)%Clock, &
2179 & starttime=starttime, &
2180 & stoptime=stoptime, &
2181 & currtime=currtime, &
2182 & timestep=timestep, &
2183 & calkindflag=calkindflag, &
2184 & runduration=runduration, &
2185 & rc=rc)
2186 IF (esmf_logfounderror(rctocheck=rc, &
2187 & msg=esmf_logerr_passthru, &
2188 & line=__line__, &
2189 & file=myfile)) THEN
2190 RETURN
2191 END IF
2192!
2193 clockinfo(idriver)%TimeStep = timestep
2194 clockinfo(idriver)%CurrentTime = currtime
2195 clockinfo(idriver)%StartTime = starttime
2196 clockinfo(idriver)%StopTime = stoptime
2197!
2198 IF (calkindflag == esmf_calkind_gregorian) THEN
2199 clockinfo(idriver)%CalendarString = 'gregorian'
2200 ELSE IF (calkindflag == esmf_calkind_360day) THEN
2201 clockinfo(idriver)%CalendarString = '360_day'
2202 END IF
2203!
2204 CALL esmf_timeget (clockinfo(idriver)%StartTime, &
2205 & s_r8=clockinfo(idriver)%Time_Start, &
2206 & timestring=timestartstring, &
2207 & rc=rc)
2208 IF (esmf_logfounderror(rctocheck=rc, &
2209 & msg=esmf_logerr_passthru, &
2210 & line=__line__, &
2211 & file=myfile)) THEN
2212 RETURN
2213 END IF
2214!
2215 is=index(timestartstring, 'T')
2216 IF (is.gt.0) timestartstring(is:is)=' '
2217 clockinfo(idriver)%Time_StartString=trim(timestartstring)
2218!
2219 CALL esmf_timeget (clockinfo(idriver)%StopTime, &
2220 & s_r8=clockinfo(idriver)%Time_Stop, &
2221 & timestring=timestopstring, &
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 is=index(timestopstring, 'T')
2231 IF (is.gt.0) timestopstring(is:is)=' '
2232 clockinfo(idriver)%Time_StopString=trim(timestopstring)
2233!
2234# ifdef REGRESS_STARTCLOCK
2235 CALL esmf_timeintervalget (runduration-timestep, &
2236 & s_r8=driverduration, &
2237 & rc=rc)
2238 IF (esmf_logfounderror(rctocheck=rc, &
2239 & msg=esmf_logerr_passthru, &
2240 & line=__line__, &
2241 & file=myfile)) THEN
2242 RETURN
2243 END IF
2244# else
2245 CALL esmf_timeintervalget (runduration, &
2246 & s_r8=driverduration, &
2247 & rc=rc)
2248 IF (esmf_logfounderror(rctocheck=rc, &
2249 & msg=esmf_logerr_passthru, &
2250 & line=__line__, &
2251 & file=myfile)) THEN
2252 RETURN
2253 END IF
2254# endif
2255!
2256 DO ng=1,models(iroms)%Ngrids
2257 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2258 romsduration=(ntend(ng)-ntfirst(ng)+1)*dt(ng)
2259 IF (romsduration.ne.driverduration) THEN
2260 IF (localpet.eq.0) THEN
2261 WRITE (cplout,10) romsduration, driverduration, &
2262 & trim(inpname(iroms))
2263 END IF
2264 rc=esmf_rc_not_valid
2265 RETURN
2266 END IF
2267 END IF
2268 END DO
2269 END IF
2270!
2271! Report Clock:
2272!
2273 IF (localpet.eq.0) THEN
2274 WRITE (cplout,20) timestartstring, timestopstring, &
2275 & int(driverduration), int(romsduration)
2276 END IF
2277!
2278!-----------------------------------------------------------------------
2279! Set-up grid and load coordinate data.
2280!-----------------------------------------------------------------------
2281!
2282 DO ng=1,models(iroms)%Ngrids
2283 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2284 CALL roms_setgridarrays (ng, tile, model, rc)
2285 IF (esmf_logfounderror(rctocheck=rc, &
2286 & msg=esmf_logerr_passthru, &
2287 & line=__line__, &
2288 & file=myfile)) THEN
2289 RETURN
2290 END IF
2291 END IF
2292 END DO
2293!
2294!-----------------------------------------------------------------------
2295! Set-up fields and register to import/export states.
2296!-----------------------------------------------------------------------
2297!
2298 DO ng=1,models(iroms)%Ngrids
2299 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2300 CALL roms_setstates (ng, tile, model, rc)
2301 IF (esmf_logfounderror(rctocheck=rc, &
2302 & msg=esmf_logerr_passthru, &
2303 & line=__line__, &
2304 & file=myfile)) THEN
2305 RETURN
2306 END IF
2307 END IF
2308 END DO
2309!
2310 IF (esm_track) THEN
2311 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetInitializeP2', &
2312 & ', PET', petrank
2313 FLUSH (trac)
2314 END IF
2315!
2316 10 FORMAT (/,' ROMS_SetInitializeP2 - inconsitent configuration ', &
2317 & 'run duration',/,24x, &
2318 & 'ROMS Duration = ',f20.2,' seconds',/,24x, &
2319 & 'Coupling Duration = ',f20.2,' seconds',/,24x, &
2320 & 'Check paramenter NTIMES in ''',a,'''',a)
2321 20 FORMAT (/,'Coupling Clock: ROMS_SetInitializeP2',/,15('='),/, &
2322 & /,2x,'DRIVER Starting Date = ',a, &
2323 & /,2x,'DRIVER Ending Date = ',a, &
2324 & /,2x,'DRIVER Duration (s) = ',i0, &
2325 & /,2x,'ROMS Duration (s) = ',i0)
2326!
2327 RETURN

References clockinfo, coupled, cplout, mod_scalars::dt, esm_track, mod_scalars::exit_flag, idriver, inpname, iroms, models, mod_scalars::noerror, mod_scalars::ntend, mod_scalars::ntfirst, petlayoutoption, petrank, roms_kernel_mod::roms_initialize(), roms_setgridarrays(), roms_setstates(), and 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 cmeps_roms_mod::roms_setrunclock ( type (esmf_gridcomp) model,
integer, intent(out) rc )
private

Definition at line 2768 of file cmeps_roms.h.

2769!
2770!=======================================================================
2771! !
2772! Sets ROMS run clock manually to avoid getting zero time stamps at !
2773! the first regridding call. !
2774! !
2775!=======================================================================
2776!
2777! Imported variable declarations.
2778!
2779 integer, intent(out) :: rc
2780!
2781 TYPE (ESMF_GridComp) :: model
2782!
2783! Local variable declarations.
2784!
2785 character (len=*), parameter :: MyFile = &
2786 & __FILE__//", ROMS_SetRunClock"
2787!
2788 TYPE (ESMF_Clock) :: driverClock, modelClock
2789 TYPE (ESMF_Time) :: currTime
2790!
2791!-----------------------------------------------------------------------
2792! Initialize return code flag to success state (no error).
2793!-----------------------------------------------------------------------
2794!
2795 IF (esm_track) THEN
2796 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetRunClock', &
2797 & ', PET', petrank
2798 FLUSH (trac)
2799 END IF
2800 rc=esmf_success
2801!
2802!-----------------------------------------------------------------------
2803! Set ROMS run clock manually.
2804!-----------------------------------------------------------------------
2805!
2806! Inquire driver and model clock.
2807!
2808 CALL nuopc_modelget (model, &
2809 & driverclock=driverclock, &
2810 & modelclock=modelclock, &
2811 & rc=rc)
2812 IF (esmf_logfounderror(rctocheck=rc, &
2813 & msg=esmf_logerr_passthru, &
2814 & line=__line__, &
2815 & file=myfile)) THEN
2816 RETURN
2817 END IF
2818!
2819! Set model clock to have the current start time as the driver clock.
2820!
2821 CALL esmf_clockget (driverclock, &
2822 & currtime=currtime, &
2823 & rc=rc)
2824 IF (esmf_logfounderror(rctocheck=rc, &
2825 & msg=esmf_logerr_passthru, &
2826 & line=__line__, &
2827 & file=myfile)) THEN
2828 RETURN
2829 END IF
2830!
2831 CALL esmf_clockset (modelclock, &
2832 & currtime=currtime, &
2833 & rc=rc)
2834 IF (esmf_logfounderror(rctocheck=rc, &
2835 & msg=esmf_logerr_passthru, &
2836 & line=__line__, &
2837 & file=myfile)) THEN
2838 RETURN
2839 END IF
2840!
2841! Check and set the component clock against the driver clock.
2842!
2843 CALL nuopc_compchecksetclock (model, &
2844 & driverclock, &
2845 & rc=rc)
2846 IF (esmf_logfounderror(rctocheck=rc, &
2847 & msg=esmf_logerr_passthru, &
2848 & line=__line__, &
2849 & file=myfile)) THEN
2850 RETURN
2851 END IF
2852!
2853 IF (esm_track) THEN
2854 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetRunClock', &
2855 & ', PET', petrank
2856 FLUSH (trac)
2857 END IF
2858!
2859 RETURN

References esm_track, petrank, and trac.

Referenced by roms_setservices().

Here is the caller graph for this function:

◆ roms_setservices()

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

Definition at line 489 of file cmeps_roms.h.

490!
491!=======================================================================
492! !
493! Sets ROMS component shared-object entry points for "initialize", !
494! "run", and "finalize" by using NUOPC generic methods. !
495! !
496!=======================================================================
497!
498! Imported variable declarations.
499!
500 integer, intent(out) :: rc
501!
502 TYPE (ESMF_GridComp) :: model
503!
504! Local variable declarations.
505!
506 character (len=*), parameter :: MyFile = &
507 & __FILE__//", ROMS_SetServices"
508!
509!-----------------------------------------------------------------------
510! Initialize return code flag to success state (no error).
511!-----------------------------------------------------------------------
512!
513 IF (esm_track) THEN
514 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetServices', &
515 & ', PET', petrank
516 FLUSH (trac)
517 END IF
518 rc=esmf_success
519!
520!-----------------------------------------------------------------------
521! Register NUOPC generic routines.
522!-----------------------------------------------------------------------
523!
524 CALL nuopc_compderive (model, &
525 & nuopc_setservices, &
526 & rc=rc)
527 IF (esmf_logfounderror(rctocheck=rc, &
528 & msg=esmf_logerr_passthru, &
529 & line=__line__, &
530 & file=myfile)) THEN
531 RETURN
532 END IF
533!
534!-----------------------------------------------------------------------
535! Register initialize routines.
536!-----------------------------------------------------------------------
537!
538! Set routine for Phase 1 initialization (import and export fields).
539!
540 CALL nuopc_compsetentrypoint (model, &
541 & methodflag=esmf_method_initialize, &
542 & phaselabellist=(/"IPDv00p1"/), &
543 & userroutine=roms_setinitializep1, &
544 & rc=rc)
545 IF (esmf_logfounderror(rctocheck=rc, &
546 & msg=esmf_logerr_passthru, &
547 & line=__line__, &
548 & file=myfile)) THEN
549 RETURN
550 END IF
551!
552! Set routine for Phase 2 initialization (exchange arrays).
553!
554 CALL nuopc_compsetentrypoint (model, &
555 & methodflag=esmf_method_initialize, &
556 & phaselabellist=(/"IPDv00p2"/), &
557 & userroutine=roms_setinitializep2, &
558 & rc=rc)
559 IF (esmf_logfounderror(rctocheck=rc, &
560 & msg=esmf_logerr_passthru, &
561 & line=__line__, &
562 & file=myfile)) THEN
563 RETURN
564 END IF
565!
566!-----------------------------------------------------------------------
567! Attach ROMS component phase independent specializing methods.
568!-----------------------------------------------------------------------
569!
570! Set routine for export initial/restart fields.
571!
572 CALL nuopc_compspecialize (model, &
573 & speclabel=nuopc_label_datainitialize, &
574 & specroutine=roms_datainit, &
575 & rc=rc)
576 IF (esmf_logfounderror(rctocheck=rc, &
577 & msg=esmf_logerr_passthru, &
578 & line=__line__, &
579 & file=myfile)) THEN
580 RETURN
581 END IF
582!
583! Set routine for setting ROMS clock.
584!
585 CALL nuopc_compspecialize (model, &
586 & speclabel=nuopc_label_setclock, &
587 & specroutine=roms_setclock, &
588 & rc=rc)
589 IF (esmf_logfounderror(rctocheck=rc, &
590 & msg=esmf_logerr_passthru, &
591 & line=__line__, &
592 & file=myfile)) THEN
593 RETURN
594 END IF
595
596# ifdef ESM_SETRUNCLOCK
597!
598! Set routine for setting ROMS run clock manually. First, remove the
599! default.
600!
601 CALL esmf_methodremove (model, &
602 & nuopc_label_setrunclock, &
603 & rc=rc)
604 IF (esmf_logfounderror(rctocheck=rc, &
605 & msg=esmf_logerr_passthru, &
606 & line=__line__, &
607 & file=myfile)) THEN
608 RETURN
609 END IF
610!
611 CALL nuopc_compspecialize (model, &
612 & speclabel=nuopc_label_setrunclock, &
613 & specroutine=roms_setrunclock, &
614 & rc=rc)
615 IF (esmf_logfounderror(rctocheck=rc, &
616 & msg=esmf_logerr_passthru, &
617 & line=__line__, &
618 & file=myfile)) THEN
619 RETURN
620 END IF
621# endif
622!
623! Set routine for checking import state.
624!
625 CALL nuopc_compspecialize (model, &
626 & speclabel=nuopc_label_checkimport, &
627 & specphaselabel="RunPhase1", &
628 & specroutine=roms_checkimport, &
629 & rc=rc)
630 IF (esmf_logfounderror(rctocheck=rc, &
631 & msg=esmf_logerr_passthru, &
632 & line=__line__, &
633 & file=myfile)) THEN
634 RETURN
635 END IF
636!
637! Set routine for time-stepping ROMS component.
638!
639 CALL nuopc_compspecialize (model, &
640 & speclabel=nuopc_label_advance, &
641 & specroutine=roms_modeladvance, &
642 & rc=rc)
643 IF (esmf_logfounderror(rctocheck=rc, &
644 & msg=esmf_logerr_passthru, &
645 & line=__line__, &
646 & file=myfile)) THEN
647 RETURN
648 END IF
649!
650!-----------------------------------------------------------------------
651! Register ROMS finalize routine.
652!-----------------------------------------------------------------------
653!
654 CALL esmf_gridcompsetentrypoint (model, &
655 & methodflag=esmf_method_finalize, &
656 & userroutine=roms_setfinalize, &
657 & rc=rc)
658 IF (esmf_logfounderror(rctocheck=rc, &
659 & msg=esmf_logerr_passthru, &
660 & line=__line__, &
661 & file=myfile)) THEN
662 RETURN
663 END IF
664!
665 IF (esm_track) THEN
666 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetServices', &
667 & ', PET', petrank
668 FLUSH (trac)
669 END IF
670!
671 RETURN

References esm_track, petrank, roms_checkimport(), roms_datainit(), roms_modeladvance(), roms_setclock(), roms_setfinalize(), roms_setinitializep1(), roms_setinitializep2(), roms_setrunclock(), and 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_setstates()

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

Definition at line 3588 of file cmeps_roms.h.

3589!
3590!=======================================================================
3591! !
3592! Adds ROMS component export and import fields into its respective !
3593! state. !
3594! !
3595!=======================================================================
3596!
3597! Imported variable declarations.
3598!
3599 integer, intent(in) :: ng, tile
3600 integer, intent(out) :: rc
3601!
3602 TYPE (ESMF_GridComp) :: model
3603!
3604! Local variable declarations.
3605!
3606 integer :: id, ifld
3607 integer :: localDE, localDEcount, localPET
3608 integer :: ExportCount, ImportCount
3609!
3610 real (dp), dimension(:,:), pointer :: ptr2d => null()
3611!
3612 character (len=10) :: AttList(1)
3613
3614 character (len=*), parameter :: MyFile = &
3615 & __FILE__//", ROMS_SetStates"
3616!
3617 character (ESMF_MAXSTR), allocatable :: ExportNameList(:)
3618 character (ESMF_MAXSTR), allocatable :: ImportNameList(:)
3619!
3620 TYPE (ESMF_ArraySpec) :: arraySpec2d
3621 TYPE (ESMF_Field) :: field, field_scalar
3622 TYPE (ESMF_StaggerLoc) :: staggerLoc
3623 TYPE (ESMF_VM) :: vm
3624!
3625!-----------------------------------------------------------------------
3626! Initialize return code flag to success state (no error).
3627!-----------------------------------------------------------------------
3628!
3629 IF (esm_track) THEN
3630 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetStates', &
3631 & ', PET', petrank
3632 FLUSH (trac)
3633 END IF
3634 rc=esmf_success
3635!
3636!-----------------------------------------------------------------------
3637! Query gridded component.
3638!-----------------------------------------------------------------------
3639!
3640! Get import and export states.
3641!
3642 CALL esmf_gridcompget (model, &
3643 & localpet=localpet, &
3644 & vm=vm, &
3645 & rc=rc)
3646 IF (esmf_logfounderror(rctocheck=rc, &
3647 & msg=esmf_logerr_passthru, &
3648 & line=__line__, &
3649 & file=myfile)) THEN
3650 RETURN
3651 END IF
3652!
3653! Get number of local decomposition elements (DEs). Usually, a single
3654! Decomposition Element (DE) is associated with each Persistent
3655! Execution Thread (PETs). Thus, localDEcount=1.
3656!
3657 CALL esmf_gridget (models(iroms)%grid(ng), &
3658 & localdecount=localdecount, &
3659 & rc=rc)
3660 IF (esmf_logfounderror(rctocheck=rc, &
3661 & msg=esmf_logerr_passthru, &
3662 & line=__line__, &
3663 & file=myfile)) THEN
3664 RETURN
3665 END IF
3666!
3667!-----------------------------------------------------------------------
3668! Set a 2D floating-point array descriptor.
3669!-----------------------------------------------------------------------
3670!
3671 CALL esmf_arrayspecset (arrayspec2d, &
3672 & typekind=esmf_typekind_r8, &
3673 & rank=2, &
3674 & rc=rc)
3675 IF (esmf_logfounderror(rctocheck=rc, &
3676 & msg=esmf_logerr_passthru, &
3677 & line=__line__, &
3678 & file=myfile)) THEN
3679 RETURN
3680 END IF
3681!
3682!-----------------------------------------------------------------------
3683! Add export fields into export state.
3684!-----------------------------------------------------------------------
3685!
3686 exporting : IF (nexport(iroms).gt.0) THEN
3687!
3688! Get number of fields to export.
3689!
3690 CALL esmf_stateget (models(iroms)%ExportState(ng), &
3691 & itemcount=exportcount, &
3692 & rc=rc)
3693 IF (esmf_logfounderror(rctocheck=rc, &
3694 & msg=esmf_logerr_passthru, &
3695 & line=__line__, &
3696 & file=myfile)) THEN
3697 RETURN
3698 END IF
3699!
3700! Get a list of export fields names.
3701!
3702 IF (.not.allocated(exportnamelist)) THEN
3703 allocate ( exportnamelist(exportcount) )
3704 END IF
3705 CALL esmf_stateget (models(iroms)%ExportState(ng), &
3706 & itemnamelist=exportnamelist, &
3707 & rc=rc)
3708 IF (esmf_logfounderror(rctocheck=rc, &
3709 & msg=esmf_logerr_passthru, &
3710 & line=__line__, &
3711 & file=myfile)) THEN
3712 RETURN
3713 END IF
3714!
3715! Set export field(s).
3716!
3717 DO ifld=1,exportcount
3718 id=field_index(models(iroms)%ExportField,exportnamelist(ifld))
3719!
3720 IF (nuopc_isconnected(models(iroms)%ExportState(ng), &
3721 & fieldname=trim(exportnamelist(ifld)), &
3722 & rc=rc)) THEN
3723!
3724! If cmeps scalar field, 'cpl_scalars', add it to Export State.
3725!
3726 IF (trim(exportnamelist(ifld)).eq. &
3727 & trim(scalarfieldname)) THEN
3728!
3729! Create scalar field.
3730!
3731 CALL createscalarfield(field, &
3732 & scalarfieldname, &
3733 & scalarfieldcount, &
3734 & rc)
3735 IF (esmf_logfounderror(rctocheck=rc, &
3736 & msg=esmf_logerr_passthru, &
3737 & line=__line__, &
3738 & file=myfile)) THEN
3739 RETURN
3740 END IF
3741!
3742! Set values and fill scalar field.
3743!
3744 CALL setscalarfieldvalues(field, &
3745 & (/ lm(ng)+2, mm(ng)+2 /), &
3746 & (/ scalarfieldidxgridnx, &
3747 & scalarfieldidxgridny /), &
3748 & rc=rc)
3749 IF (esmf_logfounderror(rctocheck=rc, &
3750 & msg=esmf_logerr_passthru, &
3751 & line=__line__, &
3752 & file=myfile)) THEN
3753 RETURN
3754 END IF
3755!
3756! Otherwise, proccess regular ROMS export field(s).
3757!
3758 ELSE
3759!
3760! Set staggering type.
3761!
3762 SELECT CASE (models(iroms)%ExportField(id)%gtype)
3763 CASE (icenter) ! RHO-points
3764 staggerloc=esmf_staggerloc_center
3765 CASE (icorner) ! PSI-points
3766 staggerloc=esmf_staggerloc_corner
3767 CASE (iupoint) ! U-points
3768 staggerloc=esmf_staggerloc_edge1
3769 CASE (ivpoint) ! V-points
3770 staggerloc=esmf_staggerloc_edge2
3771 END SELECT
3772!
3773! Create 2D field from the Grid and arraySpec.
3774!
3775 field=esmf_fieldcreate(models(iroms)%grid(ng), &
3776 & arrayspec2d, &
3777 & indexflag=esmf_index_global, &
3778 & staggerloc=staggerloc, &
3779 & name=trim(exportnamelist(ifld)), &
3780 & rc=rc)
3781 IF (esmf_logfounderror(rctocheck=rc, &
3782 & msg=esmf_logerr_passthru, &
3783 & line=__line__, &
3784 & file=myfile)) THEN
3785 RETURN
3786 END IF
3787!
3788! Put data into state. Usually, the DO-loop is executed once since
3789! localDEcount=1.
3790!
3791 DO localde=0,localdecount-1
3792!
3793! Get pointer to DE-local memory allocation within field.
3794!
3795 CALL esmf_fieldget (field, &
3796 & localde=localde, &
3797 & farrayptr=ptr2d, &
3798 & rc=rc)
3799 IF (esmf_logfounderror(rctocheck=rc, &
3800 & msg=esmf_logerr_passthru, &
3801 & line=__line__, &
3802 & file=myfile)) THEN
3803 RETURN
3804 END IF
3805!
3806! Initialize pointer.
3807!
3808 ptr2d=missing_dp
3809!
3810! Nullify pointer to make sure that it does not point on a random part
3811! in the memory.
3812!
3813 IF ( associated(ptr2d) ) nullify (ptr2d)
3814 END DO
3815!
3816 END IF
3817!
3818! Add field export state.
3819!
3820 CALL nuopc_realize (models(iroms)%ExportState(ng), &
3821 & field=field, &
3822 & rc=rc)
3823 IF (esmf_logfounderror(rctocheck=rc, &
3824 & msg=esmf_logerr_passthru, &
3825 & line=__line__, &
3826 & file=myfile)) THEN
3827 RETURN
3828 END IF
3829!
3830! Remove field from export state because it is not connected.
3831!
3832 ELSE
3833 IF (trim(exportnamelist(id)).ne.trim(scalarfieldname)) THEN
3834 IF (localpet.eq.0) THEN
3835 WRITE (cplout,10) trim(exportnamelist(ifld)), &
3836 & 'Export State: ', &
3837 & trim(coupled(iroms)%ExpLabel(ng))
3838 END IF
3839 CALL esmf_stateremove (models(iroms)%ExportState(ng), &
3840 & (/ trim(exportnamelist(ifld)) /), &
3841 & rc=rc)
3842 IF (esmf_logfounderror(rctocheck=rc, &
3843 & msg=esmf_logerr_passthru, &
3844 & line=__line__, &
3845 & file=myfile)) THEN
3846 RETURN
3847 END IF
3848 END IF
3849 END IF
3850 END DO
3851!
3852! Deallocate arrays.
3853!
3854 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
3855!
3856 END IF exporting
3857!
3858!-----------------------------------------------------------------------
3859! Add import fields into import state.
3860!-----------------------------------------------------------------------
3861!
3862 importing : IF (nimport(iroms).gt.0) THEN
3863!
3864! Get number of fields to import.
3865!
3866 CALL esmf_stateget (models(iroms)%ImportState(ng), &
3867 & itemcount=importcount, &
3868 & rc=rc)
3869 IF (esmf_logfounderror(rctocheck=rc, &
3870 & msg=esmf_logerr_passthru, &
3871 & line=__line__, &
3872 & file=myfile)) THEN
3873 RETURN
3874 END IF
3875!
3876! Get a list of import fields names.
3877!
3878 IF (.not.allocated(importnamelist)) THEN
3879 allocate (importnamelist(importcount))
3880 END IF
3881 CALL esmf_stateget (models(iroms)%ImportState(ng), &
3882 & itemnamelist=importnamelist, &
3883 & rc=rc)
3884 IF (esmf_logfounderror(rctocheck=rc, &
3885 & msg=esmf_logerr_passthru, &
3886 & line=__line__, &
3887 & file=myfile)) THEN
3888 RETURN
3889 END IF
3890!
3891! Set import field(s).
3892!
3893 DO ifld=1,importcount
3894 id=field_index(models(iroms)%ImportField,importnamelist(ifld))
3895!
3896 IF (nuopc_isconnected(models(iroms)%ImportState(ng), &
3897 & fieldname=trim(importnamelist(ifld)), &
3898 & rc=rc)) THEN
3899!
3900! Set staggering type.
3901!
3902 SELECT CASE (models(iroms)%ImportField(id)%gtype)
3903 CASE (icenter) ! RHO-points
3904 staggerloc=esmf_staggerloc_center
3905 CASE (icorner) ! PSI-points
3906 staggerloc=esmf_staggerloc_corner
3907 CASE (iupoint) ! U-points
3908 staggerloc=esmf_staggerloc_edge1
3909 CASE (ivpoint) ! V-points
3910 staggerloc=esmf_staggerloc_edge2
3911 END SELECT
3912!
3913! Create 2D field from the Grid, arraySpec, total tile size.
3914! The array indices are global following ROMS design.
3915!
3916 field=esmf_fieldcreate(models(iroms)%grid(ng), &
3917 & arrayspec2d, &
3918 & indexflag=esmf_index_global, &
3919 & staggerloc=staggerloc, &
3920 & name=trim(importnamelist(ifld)), &
3921 & rc=rc)
3922 IF (esmf_logfounderror(rctocheck=rc, &
3923 & msg=esmf_logerr_passthru, &
3924 & line=__line__, &
3925 & file=myfile)) THEN
3926 RETURN
3927 END IF
3928
3929# ifdef TIME_INTERP_NOT
3930!
3931! Create standard Attribute Package for each export field. Then, nest
3932! custom Attribute Package around it.
3933!
3934 CALL esmf_attributeadd (field, &
3935 & convention='ESMF', &
3936 & purpose='General', &
3937 & rc=rc)
3938 IF (esmf_logfounderror(rctocheck=rc, &
3939 & msg=esmf_logerr_passthru, &
3940 & line=__line__, &
3941 & file=myfile)) THEN
3942 RETURN
3943 END IF
3944!
3945 attlist(1)='TimeInterp'
3946 CALL esmf_attributeadd (field, &
3947 & convention='CustomConvention', &
3948 & purpose='General', &
3949!! & purpose='Instance', &
3950 & attrlist=attlist, &
3951 & nestconvention='ESMF', &
3952 & nestpurpose='General', &
3953 & rc=rc)
3954 IF (esmf_logfounderror(rctocheck=rc, &
3955 & msg=esmf_logerr_passthru, &
3956 & line=__line__, &
3957 & file=myfile)) THEN
3958 RETURN
3959 END IF
3960# endif
3961!
3962! Put data into state. Usually, the DO-loop is executed once since
3963! localDEcount=1.
3964!
3965 DO localde=0,localdecount-1
3966!
3967! Get pointer to DE-local memory allocation within field.
3968!
3969 CALL esmf_fieldget (field, &
3970 & localde=localde, &
3971 & farrayptr=ptr2d, &
3972 & rc=rc)
3973 IF (esmf_logfounderror(rctocheck=rc, &
3974 & msg=esmf_logerr_passthru, &
3975 & line=__line__, &
3976 & file=myfile)) THEN
3977 RETURN
3978 END IF
3979!
3980! Initialize pointer.
3981!
3982 ptr2d=missing_dp
3983!
3984! Nullify pointer to make sure that it does not point on a random
3985! part in the memory.
3986!
3987 IF (associated(ptr2d)) nullify (ptr2d)
3988 END DO
3989!
3990! Add field import state.
3991!
3992 CALL nuopc_realize (models(iroms)%ImportState(ng), &
3993 & field=field, &
3994 & rc=rc)
3995 IF (esmf_logfounderror(rctocheck=rc, &
3996 & msg=esmf_logerr_passthru, &
3997 & line=__line__, &
3998 & file=myfile)) THEN
3999 RETURN
4000 END IF
4001!
4002! Remove field from import state because it is not connected.
4003!
4004 ELSE
4005 IF (localpet.eq.0) THEN
4006 WRITE (cplout,10) trim(importnamelist(ifld)), &
4007 & 'Import State: ', &
4008 & trim(coupled(iroms)%ImpLabel(ng))
4009 END IF
4010 CALL esmf_stateremove (models(iroms)%ImportState(ng), &
4011 & (/ trim(importnamelist(ifld)) /), &
4012 & rc=rc)
4013 IF (esmf_logfounderror(rctocheck=rc, &
4014 & msg=esmf_logerr_passthru, &
4015 & line=__line__, &
4016 & file=myfile)) THEN
4017 RETURN
4018 END IF
4019 END IF
4020 END DO
4021!
4022! Deallocate arrays.
4023!
4024 IF (allocated(importnamelist)) deallocate (importnamelist)
4025!
4026 END IF importing
4027!
4028 IF (esm_track) THEN
4029 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetStates', &
4030 & ', PET', petrank
4031 FLUSH (trac)
4032 END IF
4033!
4034 10 FORMAT (1x,'ROMS_SetStates - Removing field ''',a,''' from ',a, &
4035 & '''',a,'''',/,18x,'because it is not connected.')
4036!
4037 RETURN

References coupled, cplout, createscalarfield(), esm_track, field_index(), icenter, icorner, iroms, iupoint, ivpoint, mod_param::lm, missing_dp, mod_param::mm, models, nexport, nimport, petrank, scalarfieldcount, scalarfieldidxgridnx, scalarfieldidxgridny, scalarfieldname, setscalarfieldvalues(), and trac.

Referenced by roms_setinitializep2().

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

◆ setscalarfieldvalues()

subroutine, private cmeps_roms_mod::setscalarfieldvalues ( type (esmf_field), intent(inout) field,
integer, dimension(:), intent(in) vals,
integer, dimension(:), intent(in) idxs,
integer, intent(inout) rc )
private

Definition at line 7026 of file cmeps_roms.h.

7027!
7028!=======================================================================
7029! !
7030! Sets scalar field. !
7031! !
7032!=======================================================================
7033!
7034! Imported variable declarations.
7035!
7036 integer, intent(in) :: vals(:)
7037 integer, intent(in) :: idxs(:)
7038 integer, intent(inout) :: rc
7039!
7040 TYPE (ESMF_Field), intent(inout) :: field
7041!
7042! Local variable declarations.
7043!
7044 integer :: I
7045 integer :: ungriddedLBound(2)
7046 integer :: ungriddedUBound(2)
7047!
7048 real (r8), pointer :: fPtr(:,:)
7049!
7050 character (len=*), parameter :: MyFile = &
7051 & __FILE__//", SetScalarFieldValues"
7052!
7053!-----------------------------------------------------------------------
7054! Initialize return code flag to success state (no error).
7055!-----------------------------------------------------------------------
7056!
7057 rc=esmf_success
7058!
7059!-----------------------------------------------------------------------
7060! Get pointer and fill the field.
7061!-----------------------------------------------------------------------
7062!
7063 CALL esmf_fieldget(field, &
7064 & ungriddedlbound=ungriddedlbound, &
7065 & ungriddedubound=ungriddedubound, &
7066 & rc=rc)
7067 IF (esmf_logfounderror(rctocheck=rc, &
7068 & msg=esmf_logerr_passthru, &
7069 & line=__line__, &
7070 & file=myfile)) THEN
7071 RETURN
7072 END IF
7073!
7074 IF (any(idxs(:).lt.ungriddedlbound(1)) .or. &
7075 any(idxs(:).gt.ungriddedubound(1))) THEN
7076 CALL esmf_logseterror(esmf_rc_arg_bad, &
7077 & msg="ScalarFieldIdxGrid[NX|NY] outside ScalarFieldCount", &
7078 & line=__line__, file=__file__, rctoreturn=rc)
7079 END IF
7080!
7081 CALL esmf_fieldget(field, farrayptr=fptr, rc=rc)
7082 IF (esmf_logfounderror(rctocheck=rc, &
7083 & msg=esmf_logerr_passthru, &
7084 & line=__line__, &
7085 & file=myfile)) THEN
7086 RETURN
7087 END IF
7088!
7089 DO i=lbound(idxs, dim=1), ubound(idxs, dim=1)
7090 fptr(idxs(i),1) = dble(vals(i))
7091 END DO
7092!
7093 RETURN

Referenced by roms_setstates().

Here is the caller graph for this function:

Variable Documentation

◆ clockinfo

type (esm_clock), dimension(:), allocatable, target cmeps_roms_mod::clockinfo

Definition at line 195 of file cmeps_roms.h.

195 TYPE (ESM_Clock), allocatable, target :: ClockInfo(:)

Referenced by esmf_esm_mod::esm_setmodelservices(), esmf_esm_mod::esm_setrunsequence(), roms_create(), roms_datainit(), roms_export(), roms_modeladvance(), roms_setclock(), and roms_setinitializep2().

◆ coupled

type (esm_cplset), dimension(:), allocatable, target cmeps_roms_mod::coupled

Definition at line 211 of file cmeps_roms.h.

211 TYPE (ESM_CplSet), allocatable, target :: COUPLED(:)

Referenced by roms_checkimport(), roms_create(), roms_datainit(), roms_modeladvance(), roms_setclock(), roms_setinitializep1(), roms_setinitializep2(), and roms_setstates().

◆ coupledset

character (len=:), allocatable cmeps_roms_mod::coupledset

Definition at line 424 of file cmeps_roms.h.

424 character (len=:), allocatable :: CoupledSet

Referenced by roms_setinitializep1().

◆ couplerlog

character (len=11), parameter cmeps_roms_mod::couplerlog = 'log.coupler'

Definition at line 363 of file cmeps_roms.h.

363 character (len=11), parameter :: CouplerLog = 'log.coupler'

Referenced by roms_setinitializep1().

◆ couplingtype

integer cmeps_roms_mod::couplingtype = 1

Definition at line 326 of file cmeps_roms.h.

326 integer :: CouplingType = 1

Referenced by roms_checkimport(), and roms_create().

◆ cplname

character (len=:), allocatable cmeps_roms_mod::cplname

Definition at line 411 of file cmeps_roms.h.

411 character (len=:), allocatable :: CPLname

Referenced by roms_create(), roms_export(), roms_import(), and roms_setinitializep1().

◆ cplout

integer cmeps_roms_mod::cplout = 77

Definition at line 360 of file cmeps_roms.h.

360 integer :: cplout = 77 ! coupling driver

Referenced by esmf_esm_mod::esm_setrunsequence(), report_timestamp(), roms_checkimport(), roms_create(), roms_export(), roms_import(), roms_modeladvance(), roms_setclock(), roms_setfinalize(), roms_setgridarrays(), roms_setinitializep1(), roms_setinitializep2(), and roms_setstates().

◆ debuglevel

integer cmeps_roms_mod::debuglevel = 0

Definition at line 346 of file cmeps_roms.h.

346 integer :: DebugLevel = 0

Referenced by esmf_esm_mod::esm_setmodelservices(), esmf_esm_mod::esm_setrunsequence(), roms_checkimport(), roms_create(), roms_export(), roms_import(), and roms_setgridarrays().

◆ esm_track

logical cmeps_roms_mod::esm_track = .TRUE.

Definition at line 299 of file cmeps_roms.h.

299 logical :: ESM_track = .true. ! trace/track CALL sequence switch

Referenced by esmf_esm_mod::esm_setmodelservices(), esmf_esm_mod::esm_setrunsequence(), esmf_esm_mod::esm_setservices(), roms_checkimport(), roms_create(), roms_datainit(), roms_export(), roms_import(), roms_modeladvance(), roms_rotate(), roms_setclock(), roms_setfinalize(), roms_setgridarrays(), roms_setinitializep1(), roms_setinitializep2(), roms_setrunclock(), roms_setservices(), and roms_setstates().

◆ esmcomm

integer, dimension(:), allocatable cmeps_roms_mod::esmcomm

Definition at line 335 of file cmeps_roms.h.

335 integer, allocatable :: ESMcomm(:)

Referenced by roms_create().

◆ exportstatename

character (len=:), allocatable cmeps_roms_mod::exportstatename

Definition at line 425 of file cmeps_roms.h.

425 character (len=:), allocatable :: ExportStateName

◆ geo2grid

integer, parameter cmeps_roms_mod::geo2grid = 0
private

Definition at line 481 of file cmeps_roms.h.

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

Referenced by roms_import(), and roms_rotate().

◆ geo2grid_rho

integer, parameter cmeps_roms_mod::geo2grid_rho = 0
private

Definition at line 482 of file cmeps_roms.h.

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

Referenced by roms_import(), and roms_rotate().

◆ git_rev

character (len=256) cmeps_roms_mod::git_rev

Definition at line 420 of file cmeps_roms.h.

420 character (len=256) :: git_rev

◆ git_url

character (len=80) cmeps_roms_mod::git_url

Definition at line 419 of file cmeps_roms.h.

419 character (len=80) :: git_url

◆ grid2geo_rho

integer, parameter cmeps_roms_mod::grid2geo_rho = 1
private

Definition at line 483 of file cmeps_roms.h.

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

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

◆ gridtype

character (len=6), dimension(0:4) cmeps_roms_mod::gridtype = (/ 'N/A ', 'Center', 'Corner', 'U ', 'V ' /)

Definition at line 386 of file cmeps_roms.h.

386 character (len=6), dimension(0:4) :: GridType = &
387 & (/ 'N/A ', &
388 & 'Center', &
389 & 'Corner', &
390 & 'U ', &
391 & 'V ' /)

Referenced by roms_setgridarrays().

◆ ibilin

integer, parameter cmeps_roms_mod::ibilin = 1

Definition at line 396 of file cmeps_roms.h.

396 integer, parameter :: Ibilin = 1 ! bilinear

Referenced by roms_create().

◆ icenter

integer, parameter cmeps_roms_mod::icenter = 1

Definition at line 381 of file cmeps_roms.h.

381 integer, parameter :: Icenter = 1 ! cell center

Referenced by roms_create(), roms_setgridarrays(), and roms_setstates().

◆ iconsvd

integer, parameter cmeps_roms_mod::iconsvd = 3

Definition at line 398 of file cmeps_roms.h.

398 integer, parameter :: Iconsvd = 3 ! 1st-order conservative, D

Referenced by roms_create().

◆ iconsvf

integer, parameter cmeps_roms_mod::iconsvf = 4

Definition at line 399 of file cmeps_roms.h.

399 integer, parameter :: Iconsvf = 4 ! 1st-order conservative, F

Referenced by roms_create().

◆ icorner

integer, parameter cmeps_roms_mod::icorner = 2

Definition at line 382 of file cmeps_roms.h.

382 integer, parameter :: Icorner = 2 ! cell corners

Referenced by roms_create(), roms_setgridarrays(), and roms_setstates().

◆ idriver

integer, parameter cmeps_roms_mod::idriver = 0

Definition at line 304 of file cmeps_roms.h.

304 integer, parameter :: Idriver = 0

Referenced by esmf_esm_mod::esm_setmodelservices(), esmf_esm_mod::esm_setrunsequence(), roms_create(), roms_modeladvance(), roms_setclock(), and roms_setinitializep2().

◆ ifcopy

integer, parameter cmeps_roms_mod::ifcopy = 5

Definition at line 400 of file cmeps_roms.h.

400 integer, parameter :: Ifcopy = 5 ! redist

Referenced by roms_create().

◆ importstatename

character (len=:), allocatable cmeps_roms_mod::importstatename

Definition at line 426 of file cmeps_roms.h.

426 character (len=:), allocatable :: ImportStateName

◆ inan

integer, parameter cmeps_roms_mod::inan = 0

Definition at line 380 of file cmeps_roms.h.

380 integer, parameter :: Inan = 0 ! unstaggered, cell center

◆ inone

integer, parameter cmeps_roms_mod::inone = 0

Definition at line 395 of file cmeps_roms.h.

395 integer, parameter :: Inone = 0 ! none

Referenced by roms_create().

◆ inpname

character (len=256), dimension(:), allocatable cmeps_roms_mod::inpname

Definition at line 407 of file cmeps_roms.h.

407 character (len=256), allocatable :: INPname(:)

Referenced by roms_create(), and roms_setinitializep2().

◆ instod

integer, parameter cmeps_roms_mod::instod = 6

Definition at line 401 of file cmeps_roms.h.

401 integer, parameter :: InStoD = 6 ! nearest Src 2 Dst

Referenced by roms_create().

◆ instodd

integer, parameter cmeps_roms_mod::instodd = 7

Definition at line 402 of file cmeps_roms.h.

402 integer, parameter :: InStoDd = 7 ! nearest Src 2 Dst, consv D

Referenced by roms_create().

◆ instodf

integer, parameter cmeps_roms_mod::instodf = 8

Definition at line 403 of file cmeps_roms.h.

403 integer, parameter :: InStoDf = 8 ! nearest Src 2 Dst, consv F

Referenced by roms_create().

◆ ipatch

integer, parameter cmeps_roms_mod::ipatch = 2

Definition at line 397 of file cmeps_roms.h.

397 integer, parameter :: Ipatch = 2 ! high-order patch recovery

Referenced by roms_create().

◆ iroms

integer, parameter cmeps_roms_mod::iroms = 1

Definition at line 305 of file cmeps_roms.h.

305 integer, parameter :: Iroms = 1

Referenced by roms_checkimport(), roms_create(), roms_datainit(), roms_export(), roms_import(), roms_modeladvance(), roms_setclock(), roms_setgridarrays(), roms_setinitializep1(), roms_setinitializep2(), and roms_setstates().

◆ iupoint

integer, parameter cmeps_roms_mod::iupoint = 3

Definition at line 383 of file cmeps_roms.h.

383 integer, parameter :: Iupoint = 3 ! right and left cell faces

Referenced by roms_create(), roms_setgridarrays(), and roms_setstates().

◆ ivpoint

integer, parameter cmeps_roms_mod::ivpoint = 4

Definition at line 384 of file cmeps_roms.h.

384 integer, parameter :: Ivpoint = 4 ! upper and lower cell faces

Referenced by roms_create(), roms_setgridarrays(), and roms_setstates().

◆ linked_grid

integer cmeps_roms_mod::linked_grid

Definition at line 330 of file cmeps_roms.h.

330 integer :: linked_grid

Referenced by roms_create(), and roms_setinitializep1().

◆ mapped_mask

integer (i4b), parameter cmeps_roms_mod::mapped_mask = 99_i4b

Definition at line 430 of file cmeps_roms.h.

430 integer (i4b), parameter :: MAPPED_MASK = 99_i4b

◆ missing_dp

real (dp), parameter cmeps_roms_mod::missing_dp = 1.0E20_dp

Definition at line 433 of file cmeps_roms.h.

433 real (dp), parameter :: MISSING_dp = 1.0e20_dp

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

◆ missing_r4

real (r4), parameter cmeps_roms_mod::missing_r4 = 1.0E20_r4

Definition at line 434 of file cmeps_roms.h.

434 real (r4), parameter :: MISSING_r4 = 1.0e20_r4

◆ missing_r8

real (r8), parameter cmeps_roms_mod::missing_r8 = 1.0E20_r8

Definition at line 435 of file cmeps_roms.h.

435 real (r8), parameter :: MISSING_r8 = 1.0e20_r8

◆ models

type (esm_model), dimension(:), allocatable, target cmeps_roms_mod::models

Definition at line 290 of file cmeps_roms.h.

290 TYPE (ESM_Model), allocatable, target :: MODELS(:)

Referenced by esmf_esm_mod::esm_setmodelservices(), roms_checkimport(), roms_create(), roms_datainit(), roms_export(), roms_import(), roms_modeladvance(), roms_setclock(), roms_setgridarrays(), roms_setinitializep1(), roms_setinitializep2(), and roms_setstates().

◆ nexport

integer, dimension(:), allocatable cmeps_roms_mod::nexport

Definition at line 309 of file cmeps_roms.h.

309 integer, allocatable :: Nexport(:)

Referenced by roms_create(), roms_datainit(), roms_modeladvance(), roms_setinitializep1(), and roms_setstates().

◆ nimport

integer, dimension(:), allocatable cmeps_roms_mod::nimport

Definition at line 310 of file cmeps_roms.h.

310 integer, allocatable :: Nimport(:)

Referenced by roms_checkimport(), roms_create(), roms_modeladvance(), roms_setinitializep1(), and roms_setstates().

◆ nmodels

integer, parameter cmeps_roms_mod::nmodels = 1

Definition at line 303 of file cmeps_roms.h.

303 integer, parameter :: Nmodels = 1

Referenced by esmf_esm_mod::esm_setmodelservices(), and roms_create().

◆ petlayoutoption

character (len=10), dimension(:), allocatable cmeps_roms_mod::petlayoutoption

Definition at line 337 of file cmeps_roms.h.

337 character (len=10), allocatable :: PETlayoutOption(:)

Referenced by roms_create(), roms_import(), and roms_setinitializep2().

◆ petrank

integer cmeps_roms_mod::petrank

Definition at line 336 of file cmeps_roms.h.

336 integer :: PETrank

Referenced by esmf_esm_mod::esm_setmodelservices(), esmf_esm_mod::esm_setrunsequence(), esmf_esm_mod::esm_setservices(), roms_checkimport(), roms_create(), roms_datainit(), roms_export(), roms_import(), roms_modeladvance(), roms_rotate(), roms_setclock(), roms_setfinalize(), roms_setgridarrays(), roms_setinitializep1(), roms_setinitializep2(), roms_setrunclock(), roms_setservices(), and roms_setstates().

◆ scalarfieldcount

integer cmeps_roms_mod::scalarfieldcount

Definition at line 443 of file cmeps_roms.h.

443 integer :: ScalarFieldCount

Referenced by roms_setinitializep1(), and roms_setstates().

◆ scalarfieldidxgridnx

integer cmeps_roms_mod::scalarfieldidxgridnx

Definition at line 444 of file cmeps_roms.h.

444 integer :: ScalarFieldIdxGridNX

Referenced by roms_setinitializep1(), and roms_setstates().

◆ scalarfieldidxgridny

integer cmeps_roms_mod::scalarfieldidxgridny

Definition at line 445 of file cmeps_roms.h.

445 integer :: ScalarFieldIdxGridNY

Referenced by roms_setinitializep1(), and roms_setstates().

◆ scalarfieldname

character (len=256) cmeps_roms_mod::scalarfieldname

Definition at line 447 of file cmeps_roms.h.

447 character (len=256) :: ScalarFieldName

Referenced by roms_export(), roms_setinitializep1(), and roms_setstates().

◆ todaydatestring

character (len=44) cmeps_roms_mod::todaydatestring

Definition at line 415 of file cmeps_roms.h.

415 character (len=44) :: TodayDateString

Referenced by roms_create().

◆ tol_dp

real (dp), parameter cmeps_roms_mod::tol_dp = 0.001E20_dp

Definition at line 437 of file cmeps_roms.h.

437 real (dp), parameter :: TOL_dp = 0.001e20_dp

Referenced by roms_import().

◆ tol_r4

real (r4), parameter cmeps_roms_mod::tol_r4 = 0.001E20_r4

Definition at line 438 of file cmeps_roms.h.

438 real (r4), parameter :: TOL_r4 = 0.001e20_r4

◆ tol_r8

real (r8), parameter cmeps_roms_mod::tol_r8 = 0.001E20_r8

Definition at line 439 of file cmeps_roms.h.

439 real (r8), parameter :: TOL_r8 = 0.001e20_r8

◆ trac

integer cmeps_roms_mod::trac = 6

Definition at line 361 of file cmeps_roms.h.

361 integer :: trac = 6 ! trace/track CALL sequence unit

Referenced by esmf_esm_mod::esm_setmodelservices(), esmf_esm_mod::esm_setrunsequence(), esmf_esm_mod::esm_setservices(), roms_checkimport(), roms_create(), roms_datainit(), roms_export(), roms_import(), roms_modeladvance(), roms_rotate(), roms_setclock(), roms_setfinalize(), roms_setgridarrays(), roms_setinitializep1(), roms_setinitializep2(), roms_setrunclock(), roms_setservices(), and roms_setstates().

◆ tracelevel

integer cmeps_roms_mod::tracelevel = 0

Definition at line 356 of file cmeps_roms.h.

356 integer :: TraceLevel = 0

Referenced by roms_create().

◆ unmapped_mask

integer (i4b), parameter cmeps_roms_mod::unmapped_mask = 98_i4b

Definition at line 431 of file cmeps_roms.h.

431 integer (i4b), parameter :: UNMAPPED_MASK = 98_i4b