class - 如何在 Fortran 2003 中以多态方式解除分配？-6ren

class - 如何在 Fortran 2003 中以多态方式解除分配？

转载作者：行者123 更新时间：2023-12-01 11:03:28

在尝试实现用户派生的类型层次结构之前，我试图了解使用 Fortran 2003 功能的多态重新分配。理想的目标是弄清楚如何释放可能指向任何其他兼容子类型的已声明父类型指针。

如以下代码所示，文件 liboo.f90 声明了一个基类型 Parent 和一个继承类型 Child。对于标量和数组情况，这两种类型都分别具有 FINAL。文件 test_liboo.f90 使用 18 个不同的子例程尝试不同的释放。

子例程 TestParent_3_POINTER_CLASS, TestParent_7_array_POINTER_CLASS,TestChild_3_POINTER_CLASS, TestChild_7_array_POINTER_CLASS,TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents,TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents，都给出段错误。 TestParent_3_POINTER_CLASS 的错误消息如下所示。

子例程 TestPolymorph_1_Pointer_TypeForChild_ClassForParent 说 forrtl: severe (173): A pointer passed to DEALLOCATE points to an array that cannot be deallocated。

可以帮忙评论一下原因吗？

TestPolymorph_2_Pointer_ClassForChild_ClassForParent 不会给出段错误，只会调用 Child 的 Final，而 TestChild_1 等可以同时调用 Child 的 Final 和 Parent 的 Final，这应该是可取的。

我想知道如何在 Fortran 2003 中解除分配实际上包含继承类型的已声明父类型？任何见解将不胜感激!

PS:编译器为Intel Fortran Compiler，版本如下:

[root@localhost new]# ifort --version
ifort (IFORT) 12.1.0 20111011
Copyright (C) 1985-2011 Intel Corporation.  All rights reserved.

错误信息之一

[root@localhost new]# make clean
rm -rf liboo.mod liboo.o test_liboo.o test_liboo
[root@localhost new]# make
ifort -c -O0 -check -g -traceback  -openmp liboo.f90
ifort -c -O0 -check -g -traceback  -openmp test_liboo.f90
ifort -o test_liboo liboo.o test_liboo.o -static  -openmp 
[root@localhost new]# ./test_liboo
 TestParent_1 begins.
 DestroyParent
 TestParent_1 ends.

 TestParent_2_POINTER_TYPE begins.
 DestroyParent
 TestParent_2_POINTER_TYPE ends.

 TestParent_3_POINTER_CLASS begins.
 DestroyParent
forrtl: severe (174): SIGSEGV, segmentation fault occurred
Image              PC                Routine            Line        Source             
test_liboo         0000000000404B9C  Unknown               Unknown  Unknown
test_liboo         0000000000404A9F  Unknown               Unknown  Unknown
test_liboo         0000000000401ED5  test_liboo_IP_tes         140  test_liboo.f90
test_liboo         0000000000400829  MAIN__                     20  test_liboo.f90
test_liboo         00000000004002EC  Unknown               Unknown  Unknown
test_liboo         00000000004F4B90  Unknown               Unknown  Unknown
test_liboo         00000000004001B9  Unknown               Unknown  Unknown
[root@localhost new]#

生成文件

# Compiler
 FC            = ifort
# Linker
 LINKER        = ${FC}
# Compiler flags  
 FCFLAGS       = -c -O0 -check -g -traceback 
 FCFLAGS2      = -openmp
# Linker flags
 FLFLAGS       = -static 
 FLFLAGS2      = -openmp
# Utilities
 RM            = rm -rf
 ECHO          = echo
 SHELL         = /bin/sh


# clear out all suffixes
.SUFFIXES:
# list only those we use
.SUFFIXES: .o .f90 .f


# define a suffix rule for .f90 -> .o
.f90.o:
    ${FC} ${FCFLAGS} ${FCFLAGS2} $<


# define a suffix rule for .f -> .o
.f.o:
    ${FC} ${FCFLAGS} ${FCFLAGS2} $<


#
test_liboo: liboo.o test_liboo.o
    ${LINKER} -o test_liboo liboo.o test_liboo.o ${FLFLAGS} ${FLFLAGS2} 


#
clean:
    ${RM} liboo.mod liboo.o test_liboo.o test_liboo

liboo.f90

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    MODULE LibOO

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7** 
        TYPE :: Parent
          INTEGER :: a    
        CONTAINS
            FINAL :: DestroyParent
            FINAL :: DestroyParents
        END TYPE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7** 
        TYPE, EXTENDS (Parent) :: child 
            INTEGER :: b
        CONTAINS
            FINAL :: DestroyChild
            FINAL :: DestroyChildren
        END TYPE

    CONTAINS

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
        SUBROUTINE DestroyParent(this)

        TYPE(Parent) :: this

        WRITE (*,*) 'DestroyParent'

        END SUBROUTINE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
        SUBROUTINE DestroyParents(this)

        TYPE(Parent), DIMENSION(:) :: this

        WRITE (*,*) 'DestroyParents'

        END SUBROUTINE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
        SUBROUTINE DestroyChild(this)

        TYPE(Child) :: this

        WRITE (*,*) 'DestroyChild'

        END SUBROUTINE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
        SUBROUTINE DestroyChildren(this)

        TYPE(Child), DIMENSION(:) :: this

        WRITE (*,*) 'DestroyChildren'

        END SUBROUTINE

    END MODULE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**

test_liboo.f90

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    PROGRAM test_liboo

    USE LibOO
    IMPLICIT NONE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**  

    WRITE (*,*) 'TestParent_1 begins.'
    CALL TestParent_1
    WRITE (*,*) 'TestParent_1 ends.'
    READ (*,*)

    WRITE (*,*) 'TestParent_2_POINTER_TYPE begins.'
    CALL TestParent_2_POINTER_TYPE
    WRITE (*,*) 'TestParent_2_POINTER_TYPE ends.'
    READ (*,*)

    WRITE (*,*) 'TestParent_3_POINTER_CLASS begins.'
    CALL TestParent_3_POINTER_CLASS
    WRITE (*,*) 'TestParent_3_POINTER_CLASS ends.'
    READ (*,*)

    WRITE (*,*) 'TestParent_4_array begins.'
    CALL TestParent_4_array
    WRITE (*,*) 'TestParent_4_array ends.'
    READ (*,*)

    WRITE (*,*) 'TestParent_5_array_ALLOCATABLE begins.'
    CALL TestParent_5_array_ALLOCATABLE
    WRITE (*,*) 'TestParent_5_array_ALLOCATABLE ends.'
    READ (*,*)

    WRITE (*,*) 'TestParent_6_array_POINTER_TYPE begins.'
    CALL TestParent_6_array_POINTER_TYPE
    WRITE (*,*) 'TestParent_6_array_POINTER_TYPE ends.'
    READ (*,*)

    WRITE (*,*) 'TestParent_7_array_POINTER_CLASS begins.'
    CALL TestParent_7_array_POINTER_CLASS
    WRITE (*,*) 'TestParent_7_array_POINTER_CLASS ends.'
    READ (*,*)

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**  

    WRITE (*,*) 'TestChild_1 begins.'
    CALL TestChild_1
    WRITE (*,*) 'TestChild_1 ends.'
    READ (*,*)

    WRITE (*,*) 'TestChild_2_POINTER_TYPE begins.'
    CALL TestChild_2_POINTER_TYPE
    WRITE (*,*) 'TestChild_2_POINTER_TYPE ends.'
    READ (*,*)

    WRITE (*,*) 'TestChild_3_POINTER_CLASS begins.'
    CALL TestChild_3_POINTER_CLASS
    WRITE (*,*) 'TestChild_3_POINTER_CLASS ends.'
    READ (*,*)

    WRITE (*,*) 'TestChild_4_array begins.'
    CALL TestChild_4_array
    WRITE (*,*) 'TestChild_4_array ends.'
    READ (*,*)

    WRITE (*,*) 'TestChild_5_array_ALLOCATABLE begins.'
    CALL TestChild_5_array_ALLOCATABLE
    WRITE (*,*) 'TestChild_5_array_ALLOCATABLE ends.'
    READ (*,*)

    WRITE (*,*) 'TestChild_6_array_POINTER_TYPE begins.'
    CALL TestChild_6_array_POINTER_TYPE
    WRITE (*,*) 'TestChild_6_array_POINTER_TYPE ends.'
    READ (*,*)

    WRITE (*,*) 'TestChild_7_array_POINTER_CLASS begins.'
    CALL TestChild_7_array_POINTER_CLASS
    WRITE (*,*) 'TestChild_7_array_POINTER_CLASS ends.'
    READ (*,*)

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**  

    WRITE (*,*) 'TestPolymorph_1_Pointer_TypeForChild_ClassForParent begins.'
    CALL TestPolymorph_1_Pointer_TypeForChild_ClassForParent
    WRITE (*,*) 'TestPolymorph_1_Pointer_TypeForChild_ClassForParent ends.'
    READ (*,*)

    WRITE (*,*) 'TestPolymorph_2_Pointer_ClassForChild_ClassForParent begins.'
    CALL TestPolymorph_2_Pointer_ClassForChild_ClassForParent
    WRITE (*,*) 'TestPolymorph_2_Pointer_ClassForChild_ClassForParent ends.'
    READ (*,*)

    WRITE (*,*) 'TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents begins.'
    CALL TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents
    WRITE (*,*) 'TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents ends.'
    READ (*,*)

    WRITE (*,*) 'TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents begins.'
    CALL TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents
    WRITE (*,*) 'TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents ends.'
    READ (*,*)

    CONTAINS

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestParent_1

    USE LibOO
    IMPLICIT NONE

    TYPE(Parent) :: myParent
    myParent%a = 6

    END SUBROUTINE TestParent_1

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestParent_2_POINTER_TYPE

    USE LibOO
    IMPLICIT NONE

    TYPE(Parent), POINTER :: pMyParent

    ALLOCATE(pMyParent)
    pMyParent%a = 6
    DEALLOCATE(pMyParent)

    END SUBROUTINE TestParent_2_POINTER_TYPE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestParent_3_POINTER_CLASS

    USE LibOO
    IMPLICIT NONE

    CLASS(Parent), POINTER :: pMyParent

    ALLOCATE(pMyParent)
    pMyParent%a = 6
    DEALLOCATE(pMyParent)

    END SUBROUTINE TestParent_3_POINTER_CLASS

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestParent_4_array

    USE LibOO
    IMPLICIT NONE

    TYPE(Parent), DIMENSION(3) :: myParents
    myParents(1)%a = 6

    END SUBROUTINE TestParent_4_array

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestParent_5_array_ALLOCATABLE

    USE LibOO
    IMPLICIT NONE

    TYPE(Parent), DIMENSION(:), ALLOCATABLE :: myParents

    ALLOCATE(myParents(3))
    myParents(1)%a = 6
    DEALLOCATE(myParents)

    END SUBROUTINE TestParent_5_array_ALLOCATABLE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestParent_6_array_POINTER_TYPE

    USE LibOO
    IMPLICIT NONE

    TYPE(Parent), DIMENSION(:), POINTER :: pMyParents

    ALLOCATE(pMyParents(3))
    pMyParents(1)%a = 6
    DEALLOCATE(pMyParents)

    END SUBROUTINE TestParent_6_array_POINTER_TYPE

 !***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestParent_7_array_POINTER_CLASS

    USE LibOO
    IMPLICIT NONE

    CLASS(Parent), DIMENSION(:), POINTER :: pMyParents

    ALLOCATE(pMyParents(3))
    pMyParents(1)%a = 6
    DEALLOCATE(pMyParents)

    END SUBROUTINE TestParent_7_array_POINTER_CLASS

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestChild_1

    USE LibOO
    IMPLICIT NONE

    TYPE(child) :: myChild
    myChild%b = 6

    END SUBROUTINE TestChild_1

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestChild_2_POINTER_TYPE

    USE LibOO
    IMPLICIT NONE

    TYPE(child), POINTER :: pMyChild

    ALLOCATE(pMyChild)
    pMyChild%b = 6
    DEALLOCATE(pMyChild)

    END SUBROUTINE TestChild_2_POINTER_TYPE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
    SUBROUTINE TestChild_3_POINTER_CLASS

    USE LibOO
    IMPLICIT NONE

    CLASS(child), POINTER :: pMyChild

    ALLOCATE(pMyChild)
    pMyChild%b = 6
    DEALLOCATE(pMyChild)

    END SUBROUTINE TestChild_3_POINTER_CLASS

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestChild_4_array

    USE LibOO 
    IMPLICIT NONE

    TYPE(child), DIMENSION(3) :: myChild
    myChild(1)%b = 6

    END SUBROUTINE TestChild_4_array

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestChild_5_array_ALLOCATABLE

    USE LibOO
    IMPLICIT NONE

    TYPE(child), DIMENSION(:), ALLOCATABLE :: myChildren
    ALLOCATE(myChildren(3))
    myChildren(1)%b = 6
    DEALLOCATE(myChildren)

    END SUBROUTINE TestChild_5_array_ALLOCATABLE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestChild_6_array_POINTER_TYPE

    USE LibOO
    IMPLICIT NONE

    TYPE(child), DIMENSION(:), POINTER :: pMyChildren

    ALLOCATE(pMyChildren(3))
    pMyChildren(1)%b = 6
    DEALLOCATE(pMyChildren)

    END SUBROUTINE TestChild_6_array_POINTER_TYPE

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestChild_7_array_POINTER_CLASS

    USE LibOO
    IMPLICIT NONE

    CLASS(child), DIMENSION(:), POINTER :: pMyChildren

    ALLOCATE(pMyChildren(3))
    pMyChildren(1)%b = 6
    DEALLOCATE(pMyChildren)

    END SUBROUTINE TestChild_7_array_POINTER_CLASS

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestPolymorph_1_Pointer_TypeForChild_ClassForParent

    USE LibOO
    IMPLICIT NONE

    TYPE(child), POINTER :: pMyChild
    CLASS(parent), POINTER :: pMyParent

    ALLOCATE(pMyChild)
    pMyChild%b = 6
    pMyParent => pMyChild
    DEALLOCATE(pMyParent)

    END SUBROUTINE TestPolymorph_1_Pointer_TypeForChild_ClassForParent

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestPolymorph_2_Pointer_ClassForChild_ClassForParent

    USE LibOO
    IMPLICIT NONE

    CLASS(child), POINTER :: pMyChild
    CLASS(parent), POINTER :: pMyParent

    ALLOCATE(pMyChild)
    pMyChild%b = 6
    pMyParent => pMyChild
    DEALLOCATE(pMyParent)

    END SUBROUTINE TestPolymorph_2_Pointer_ClassForChild_ClassForParent

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents

    USE LibOO
    IMPLICIT NONE

    TYPE(child), DIMENSION(:), POINTER :: pMyChildren
    CLASS(parent), DIMENSION(:), POINTER :: pMyParents

    ALLOCATE(pMyChildren(3))
    pMyChildren(1)%b = 6
    pMyParents => pMyChildren
    DEALLOCATE(pMyParents)

    END SUBROUTINE TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents

!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**    
    SUBROUTINE TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents

    USE LibOO
    IMPLICIT NONE

    CLASS(child), DIMENSION(:), POINTER :: pMyChildren
    CLASS(parent), DIMENSION(:), POINTER :: pMyParents

    ALLOCATE(pMyChildren(3))
    pMyChildren(1)%b = 6
    pMyParents => pMyChildren
    DEALLOCATE(pMyParents)

    END SUBROUTINE TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents

    END PROGRAM test_liboo
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**

最佳答案

您没有做错任何事 - 您使用的英特尔 Fortran 版本有一个错误。我在当前版本 (13.1.3) 中重现了它，但在 14.0 的最新测试版中没有重现，因此看起来该错误已被修复。新版本将于 9 月初发布。

关于class - 如何在 Fortran 2003 中以多态方式解除分配？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/8550873/

文章推荐： gradle - Flyway Gradle 插件 - 循环依赖

文章推荐： java - 对象和数据输入/输出流是否会产生冲突？

文章推荐： java - BouncyCasSTLe 编码差异

fortran - Fortran 2008 是否向后兼容以前的 Fortran 版本？
是的，我知道..，这不是想象的...这是一个真正的 Fortran 问题。以前的版本是指 Fortran 2003、95、90，甚至 77。我所说的“向后兼容”是指可以轻松运行为 2008 年以前
fortran - 能否将一个值从一个 Fortran 程序传递到另一个 Fortran 程序？
我有一个程序，它的变量中有一个值。一旦确定了该值，我想调用另一个程序并使用该变量的值来确定在新程序中的位置。有人知道该怎么做吗？最佳答案如果您有 Fortran 2008 编译器，您将拥有标准子例
fortran - Fortran 中的嵌套名单
namelist 是一种有用的 fortran 结构，可以从文件中快速初始化变量。 namelist 有一个名称并包含一组具有已知类型的变量。这使得它类似于 type 结构。通常情况下，给程序或子例
fortran - Fortran 能否在逻辑运算中强制遵守参数顺序？
我正在遍历索引，我正在检查我是否不在第一个循环交互和另一个条件中。如果第一个条件是 .False.，我不想评估第二个条件。 do i = 1, n if ( i /= 1 .and. var(
fortran - Fortran 中的二维数组串联
Fortran 2003 具有用于数组连接的方括号语法，Intel fortran 编译器也支持它。我在这里为矩阵连接写了一个简单的代码: program matrix implicit none r
fortran - Fortran 中未调用派生类型的自定义构造函数
我正在尝试通过重载类型名称来制作自定义数据类型构造函数。但是，在进行调用时，将调用默认构造函数。我不明白我做错了什么。这是有问题的代码片段。 module test type, pu
fortran - Fortran 中的通用映射函数
我的最终目标是在 Fortran 中有一个通用的映射函数，即一个接受任意类型 A 的数组和一个 A->B 类型的函数的函数，将此函数应用于给定数组的所有元素并返回一个B 类型的数组。我无法用数组实现它
fortran - Fortran 格式描述符的问题
我正在学习 Fortran，在使用格式编写时发现了一些奇怪的东西(我使用的是 Fortran onlinegdb) Program Hello real, dimension(3,2):: array
fortran - Fortran 是多调度编程语言吗？
Fortran 中的INTERFACE 语句是否使其成为正式实现multiple dispatch 的编程语言？？ (我问是因为所链接的维基百科文章在其看似全面的支持相关范式的示例编程语言列表中并未
fortran - Fortran 90 和 Fortran 95 之间的区别
我可以使用 Fortran 95 编译器编译 Fortran 90 文件吗？ Fortran 95 似乎有很多，但 Fortran 90 没有。最佳答案这个可以: NAGWare f95 Comp
fortran - Fortran 中的二维边界条件
嗨，我在 Fortran 中对二维离散化问题强加边界条件时遇到了麻烦。我的离散化网格是一个二维正方形，在 x,y 方向上从 -L 到 L。我想强加这样的边界条件，在 x=L 的边界线上，指定了函数
fortran - Fortran 中的断言
Fortran 是否有与 C assert 等效的标准函数/关键字？ ? 我找不到 assert我在Fortran2003标准中提到过。我发现了一些如何使用预处理器的方法，但是在这个 answer建议
fortran - FORTRAN 90中同一行上的多个语句
我有一系列的作业，使用“;”将它们分配给同一个ike。分开statemnts，但我收到此错误: 1.0;磅(1,9) 1个错误:(1)处无法分类的陈述在文件LJ.F90:223中如果每个语句都在
fortran - Fortran 中的自动数组释放
我正在使用 gfortran -std=f2008。我有一个函数，它返回一个包含可分配数组的派生类型。该函数在返回之前调用allocate()。似乎在分配数组的函数返回之后，数组会自动释放一段时间，并
fortran - Fortran 数组边界检查的运行时检查未触发
我制作了这个小型测试程序来“证明”在编译之前(或者如果你让它们可分配)，你不能在不指定它们的大小的情况下使用向量。我的观点失败了。我期待本地向量“num”会失败。程序在执行程序之前无法知道它的大小。大
fortran - Fortran 函数中的别名
出于优化原因，Fortran 强制子例程或函数的虚拟参数不是别名，即它们不指向相同的内存位置。我想知道相同的约束是否适用于函数的返回值。换句话说，对于给定的 myfunc 函数: function
fortran - Fortran 90中的堆栈溢出
我已经在Fortran 90中编写了一个相当大的程序。它已经运行了一段时间了，但是今天我尝试将其提高一个档次并增加问题的大小(这是研究非标准的有限元求解器，如果那样的话)。可以帮助任何人...)现在，
fortran - Fortran 是否有未定义的行为？
在 C 和 C++ 中，有许多操作会导致未定义的行为，即允许编译器做任何它想做的事情的情况。 Examples包括在释放变量后使用它，释放变量两次和取消引用空指针。 Fortran 是否也有未定义的行
fortran - Fortran 可以在终端中有输入和输出命令提示符吗？
通常我使用fortran进行数值分析，然后使用matlab、R和python进行后期和前期工作。我发现 matlab、R 和 python 在终端中提供了命令提示符，以便您可以运行脚本以及从命令行立
fortran - Fortran 中的无穷大
在 Fortran 中将变量设置为 +Infinity 的最安全方法是什么？目前我正在使用: program test implicit none print *,infinity() con

行者123

个人简介

我是一名优秀的程序员,十分优秀！

作者热门文章

滴滴打车优惠券免费领取

全站热门文章

首页

博学

6Ren·AI

商城