ROMS
Loading...
Searching...
No Matches
Public Member Functions | List of all members
lbc_mod::lbc_putatt Interface Reference

Public Member Functions

subroutine lbc_putatt_nf90 (ng, ncid, ncname, aname, s, status)
 
subroutine lbc_putatt_pio (ng, piofile, ncname, aname, s, status)
 

Detailed Description

Definition at line 35 of file lbc.F.

Member Function/Subroutine Documentation

◆ lbc_putatt_nf90()

subroutine lbc_mod::lbc_putatt::lbc_putatt_nf90 ( integer, intent(in) ng,
integer, intent(in) ncid,
character (*), intent(in) ncname,
character (*), intent(in) aname,
type(t_lbc), dimension(4,nlbcvar,ngrids), intent(in) s,
integer, intent(out) status )

Definition at line 676 of file lbc.F.

677!***********************************************************************
678! !
679! This routine writes lateral boundary conditions keywords strings !
680! into specified output NetCDF file global attribute. !
681! !
682! On Input: !
683! !
684! ng Nested grid number (integer) !
685! ncid NetCDF file ID (integer) !
686! ncname NetCDF filename (character) !
687! aname NetCDF global attribute name (character) !
688! S Derived type structure, TYPE(T_LBC) !
689! !
690! On Output: !
691! !
692! exit_flag Error flag (integer) stored in MOD_SCALARS !
693! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
694! status NetCDF return code (integer) !
695! !
696!***********************************************************************
697!
698 USE mod_param
699 USE mod_parallel
700 USE mod_iounits
701 USE mod_ncparam
702 USE mod_netcdf
703 USE mod_scalars
704!
705 USE strings_mod, ONLY : founderror
706!
707 implicit none
708!
709! Imported variable declarations.
710!
711 integer, intent(in) :: ng, ncid
712 integer, intent(out) :: status
713!
714 character (*), intent(in) :: ncname
715 character (*), intent(in) :: aname
716!
717 TYPE(T_LBC), intent(in) :: S(4,nLBCvar,Ngrids)
718!
719! Local variable declarations
720!
721 integer :: i, ibry, ie, ifield, is, lstr, lvar
722!
723 character (len= 1) :: newline
724 character (len= 7) :: string(4)
725 character (len= 21) :: frmt
726 character (len= 100) :: line
727 character (len=2816) :: lbc_att
728
729 character (len=*), parameter :: MyFile = &
730 & __FILE__//", lbc_putatt_nf90"
731!
732!-----------------------------------------------------------------------
733! Write lateral boundary conditions global attribute.
734!-----------------------------------------------------------------------
735!
736! Determine maximum length of state variable length.
737!
738 lvar=0
739 DO ifield=1,nlbcvar
740 IF (idbvar(ifield).gt.0) THEN
741 lvar=max(lvar, len_trim(vname(1,idbvar(ifield))))
742 END IF
743 END DO
744 WRITE (frmt,10) "(a,':',t", lvar+4, ",5a)"
745 10 FORMAT (a,i0,a)
746!
747! Initialize attribute.
748!
749 newline=char(10) ! Line Feed (LF) character for
750 lstr=len_trim(newline) ! attribute clarity with "ncdump"
751 DO i=1,len(lbc_att)
752 lbc_att(i:i)=' '
753 END DO
754 lbc_att(1:lstr)=newline(1:lstr)
755 is=lstr+1
756 WRITE (line,frmt) 'EDGE', &
757 & 'WEST ', &
758 & 'SOUTH ', &
759 & 'EAST ', &
760 & 'NORTH ', &
761 & newline(1:lstr)
762 lstr=len_trim(line)
763 ie=is+lstr
764 lbc_att(is:ie)=line(1:lstr)
765 is=ie
766!
767! Check if the local string "lbc_att" is big enough to store the
768! lateral boundary conditions global attribute.
769!
770 lstr=(nlbcvar+1)*(29+lvar+4)+1
771 IF (len(lbc_att).lt.lstr) THEN
772 IF (master) THEN
773 WRITE (stdout,20) len(lbc_att), lstr
774 20 FORMAT (/,' LBC_PUTATT_NF90 - Length of local string lbc_att',&
775 & ' too small',/,19x,'Current = ',i5,' Needed = ',i5)
776 END IF
777 exit_flag=5
778 RETURN
779 END IF
780!
781! Build attribute string.
782!
783 DO ifield=1,nlbcvar
784 IF (idbvar(ifield).gt.0) THEN
785 DO ibry=1,4
786 IF (s(ibry,ifield,ng)%Chapman_explicit) THEN
787 string(ibry)='Che '
788 ELSE IF (s(ibry,ifield,ng)%Chapman_implicit) THEN
789 string(ibry)='Cha '
790 ELSE IF (s(ibry,ifield,ng)%clamped) THEN
791 string(ibry)='Cla '
792 ELSE IF (s(ibry,ifield,ng)%closed) THEN
793 string(ibry)='Clo '
794 ELSE IF (s(ibry,ifield,ng)%Flather) THEN
795 string(ibry)='Fla '
796 ELSE IF (s(ibry,ifield,ng)%gradient) THEN
797 string(ibry)='Gra '
798 ELSE IF (s(ibry,ifield,ng)%nested) THEN
799 string(ibry)='Nes '
800 ELSE IF (s(ibry,ifield,ng)%periodic) THEN
801 string(ibry)='Per '
802 ELSE IF (s(ibry,ifield,ng)%radiation) THEN
803 IF (s(ibry,ifield,ng)%nudging) THEN
804 string(ibry)='RadNud '
805 ELSE
806 string(ibry)='Rad '
807 END IF
808 ELSE IF (s(ibry,ifield,ng)%reduced) THEN
809 string(ibry)='Red '
810 ELSE IF (s(ibry,ifield,ng)%Shchepetkin) THEN
811 string(ibry)='Shc '
812 END IF
813 END DO
814 IF (ifield.eq.nlbcvar) newline=' '
815 WRITE (line,frmt) trim(vname(1,idbvar(ifield))), &
816 & string(iwest), &
817 & string(isouth), &
818 & string(ieast), &
819 & string(inorth), &
820 & newline
821 lstr=len_trim(line)
822 ie=is+lstr
823 lbc_att(is:ie)=line(1:lstr)
824 is=ie
825 END IF
826 END DO
827!
828! Write attribute to NetCDF file.
829!
830 status=nf90_put_att(ncid, nf90_global, trim(aname), &
831 & trim(lbc_att))
832 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
833 exit_flag=3
834 ioerror=status
835 RETURN
836 END IF
837!
838 RETURN
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::idbvar
integer, dimension(:), allocatable idbvar
Definition mod_ncparam.F:521
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_netcdf
Definition mod_netcdf.F:2
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::nlbcvar
integer nlbcvar
Definition mod_param.F:355
mod_scalars
Definition mod_scalars.F:2
mod_scalars::iwest
integer, parameter iwest
Definition mod_scalars.F:1432
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idbvar, mod_scalars::ieast, mod_scalars::inorth, mod_iounits::ioerror, mod_scalars::isouth, mod_scalars::iwest, mod_parallel::master, mod_iounits::stdout, and mod_ncparam::vname.

Here is the call graph for this function:

◆ lbc_putatt_pio()

subroutine lbc_mod::lbc_putatt::lbc_putatt_pio ( integer, intent(in) ng,
type (file_desc_t), intent(in) piofile,
character (*), intent(in) ncname,
character (*), intent(in) aname,
type(t_lbc), dimension(4,nlbcvar,ngrids), intent(in) s,
integer, intent(out) status )

Definition at line 845 of file lbc.F.

846!***********************************************************************
847! !
848! This routine writes lateral boundary conditions keywords strings !
849! into specified output NetCDF file global attribute. !
850! !
851! On Input: !
852! !
853! ng Nested grid number (integer) !
854! pioFile PIO file descriptor structure, TYPE(File_desc_t) !
855! pioFile%fh file handler !
856! pioFile%iosystem IO system descriptor (struct) !
857! ncname PIO filename (character) !
858! aname PIO global attribute name (character) !
859! S Derived type structure, TYPE(T_LBC) !
860! !
861! On Output: !
862! !
863! exit_flag Error flag (integer) stored in MOD_SCALARS !
864! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
865! status NetCDF return code (integer) !
866! !
867!***********************************************************************
868!
869 USE mod_param
870 USE mod_parallel
871 USE mod_iounits
872 USE mod_ncparam
873 USE mod_scalars
874 USE pio
875!
876 USE strings_mod, ONLY : founderror
877!
878 implicit none
879!
880! Imported variable declarations.
881!
882 integer, intent(in) :: ng
883 integer, intent(out) :: status
884!
885 character (*), intent(in) :: ncname
886 character (*), intent(in) :: aname
887!
888 TYPE (File_desc_t), intent(in) :: pioFile
889 TYPE(T_LBC), intent(in) :: S(4,nLBCvar,Ngrids)
890!
891! Local variable declarations
892!
893 integer :: i, ibry, ie, ifield, is, lstr, lvar
894!
895 character (len= 1) :: newline
896 character (len= 7) :: string(4)
897 character (len= 21) :: frmt
898 character (len= 100) :: line
899 character (len=2816) :: lbc_att
900
901 character (len=*), parameter :: MyFile = &
902 & __FILE__//", lbc_putatt_pio"
903!
904!-----------------------------------------------------------------------
905! Write lateral boundary conditions global attribute.
906!-----------------------------------------------------------------------
907!
908! Determine maximum length of state variable length.
909!
910 lvar=0
911 DO ifield=1,nlbcvar
912 IF (idbvar(ifield).gt.0) THEN
913 lvar=max(lvar, len_trim(vname(1,idbvar(ifield))))
914 END IF
915 END DO
916 WRITE (frmt,10) "(a,':',t", lvar+4, ",5a)"
917 10 FORMAT (a,i0,a)
918!
919! Initialize attribute.
920!
921 newline=char(10) ! Line Feed (LF) character for
922 lstr=len_trim(newline) ! attribute clarity with "ncdump"
923 DO i=1,len(lbc_att)
924 lbc_att(i:i)=' '
925 END DO
926 lbc_att(1:lstr)=newline(1:lstr)
927 is=lstr+1
928 WRITE (line,frmt) 'EDGE', &
929 & 'WEST ', &
930 & 'SOUTH ', &
931 & 'EAST ', &
932 & 'NORTH ', &
933 & newline(1:lstr)
934 lstr=len_trim(line)
935 ie=is+lstr
936 lbc_att(is:ie)=line(1:lstr)
937 is=ie
938!
939! Check if the local string "lbc_att" is big enough to store the
940! lateral boundary conditions global attribute.
941!
942 lstr=(nlbcvar+1)*(29+lvar+4)+1
943 IF (len(lbc_att).lt.lstr) THEN
944 IF (master) THEN
945 WRITE (stdout,20) len(lbc_att), lstr
946 20 FORMAT (/,' LBC_PUTATT_PIO - Length of local string lbc_att', &
947 & ' too small',/,18x,'Current = ',i5,' Needed = ',i5)
948 END IF
949 exit_flag=5
950 RETURN
951 END IF
952!
953! Build attribute string.
954!
955 DO ifield=1,nlbcvar
956 IF (idbvar(ifield).gt.0) THEN
957 DO ibry=1,4
958 IF (s(ibry,ifield,ng)%Chapman_explicit) THEN
959 string(ibry)='Che '
960 ELSE IF (s(ibry,ifield,ng)%Chapman_implicit) THEN
961 string(ibry)='Cha '
962 ELSE IF (s(ibry,ifield,ng)%clamped) THEN
963 string(ibry)='Cla '
964 ELSE IF (s(ibry,ifield,ng)%closed) THEN
965 string(ibry)='Clo '
966 ELSE IF (s(ibry,ifield,ng)%Flather) THEN
967 string(ibry)='Fla '
968 ELSE IF (s(ibry,ifield,ng)%gradient) THEN
969 string(ibry)='Gra '
970 ELSE IF (s(ibry,ifield,ng)%nested) THEN
971 string(ibry)='Nes '
972 ELSE IF (s(ibry,ifield,ng)%periodic) THEN
973 string(ibry)='Per '
974 ELSE IF (s(ibry,ifield,ng)%radiation) THEN
975 IF (s(ibry,ifield,ng)%nudging) THEN
976 string(ibry)='RadNud '
977 ELSE
978 string(ibry)='Rad '
979 END IF
980 ELSE IF (s(ibry,ifield,ng)%reduced) THEN
981 string(ibry)='Red '
982 ELSE IF (s(ibry,ifield,ng)%Shchepetkin) THEN
983 string(ibry)='Shc '
984 END IF
985 END DO
986 IF (ifield.eq.nlbcvar) newline=' '
987 WRITE (line,frmt) trim(vname(1,idbvar(ifield))), &
988 & string(iwest), &
989 & string(isouth), &
990 & string(ieast), &
991 & string(inorth), &
992 & newline
993 lstr=len_trim(line)
994 ie=is+lstr
995 lbc_att(is:ie)=line(1:lstr)
996 is=ie
997 END IF
998 END DO
999!
1000! Write attribute to NetCDF file.
1001!
1002 status=pio_put_att(piofile, pio_global, trim(aname), &
1003 & trim(lbc_att))
1004 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1005 exit_flag=3
1006 ioerror=status
1007 RETURN
1008 END IF
1009!
1010 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idbvar, mod_scalars::ieast, mod_scalars::inorth, mod_iounits::ioerror, mod_scalars::isouth, mod_scalars::iwest, mod_parallel::master, mod_iounits::stdout, and mod_ncparam::vname.

Here is the call graph for this function:
The documentation for this interface was generated from the following file: